diff --git a/Chart.cabal b/Chart.cabal --- a/Chart.cabal +++ b/Chart.cabal @@ -1,8 +1,8 @@ Name: Chart -Version: 0.9 +Version: 0.10 License: BSD3 License-file: LICENSE -Copyright: Tim Docker, 2006 +Copyright: Tim Docker, 2006-2009 Author: Tim Docker Maintainer: Tim Docker Homepage: http://www.dockerz.net/software/chart.html diff --git a/Graphics/Rendering/Chart/Axis.hs b/Graphics/Rendering/Chart/Axis.hs --- a/Graphics/Rendering/Chart/Axis.hs +++ b/Graphics/Rendering/Chart/Axis.hs @@ -38,6 +38,7 @@ AxisStyle(..), PlotValue(..), LogValue(..), + PlotIndex(..), AxisFn, defaultAxisLineStyle, @@ -49,14 +50,19 @@ timeAxis, autoTimeAxis, days, months, years, + autoIndexAxis, + addIndexes, axisToRenderable, renderAxisGrid, axisOverhang, + vmap, - axisGridNone, axisGridAtTicks, axisGridAtLabels, + axisGridHide, + axisTicksHide, + axisLabelsHide, axis_viewport, axis_ticks, @@ -139,8 +145,8 @@ render=renderAxis at } -axisGridNone :: AxisData x -> AxisData x -axisGridNone ad = ad{axis_grid_=[]} +axisGridHide :: AxisData x -> AxisData x +axisGridHide ad = ad{axis_grid_=[]} axisGridAtTicks :: AxisData x -> AxisData x axisGridAtTicks ad = ad{axis_grid_=map fst (axis_ticks_ ad)} @@ -148,6 +154,12 @@ axisGridAtLabels :: AxisData x -> AxisData x axisGridAtLabels ad = ad{axis_grid_=map fst (axis_labels_ ad)} +axisTicksHide :: AxisData x -> AxisData x +axisTicksHide ad = ad{axis_ticks_=[]} + +axisLabelsHide :: AxisData x -> AxisData x +axisLabelsHide ad = ad{axis_labels_=[]} + minsizeAxis :: AxisT x -> CRender RectSize minsizeAxis (AxisT at as rev ad) = do let labels = map snd (axis_labels_ ad) @@ -156,7 +168,7 @@ mapM textSize labels let (lw,lh) = foldl maxsz (0,0) labelSizes let ag = axis_label_gap_ as - let tsize = maximum [ max 0 (-l) | (v,l) <- axis_ticks_ ad ] + let tsize = maximum ([0] ++ [ max 0 (-l) | (v,l) <- axis_ticks_ ad ]) let sz = case at of E_Top -> (lw,max (addIfNZ lh ag) tsize) E_Bottom -> (lw,max (addIfNZ lh ag) tsize) @@ -557,6 +569,39 @@ instance PlotValue LocalTime where toValue = doubleFromLocalTime autoAxis = autoTimeAxis + +---------------------------------------------------------------------- + +-- | Type for capturing values plotted by index number +-- (ie position in a list) rather than a numerical value +newtype PlotIndex = PlotIndex { plotindex_i :: Int } + deriving (Eq,Ord) + +instance PlotValue PlotIndex where + toValue (PlotIndex i)= fromIntegral i + autoAxis = autoIndexAxis [] + +-- | Create an axis for values indexed by position. The +-- list of strings are the labels to be used. +autoIndexAxis :: [String] -> [PlotIndex] -> AxisData PlotIndex +autoIndexAxis labels vs = AxisData { + axis_viewport_= vport, + axis_ticks_ = [], + axis_labels_ = filter (\(i,l) -> i >= imin && i <= imax) (addIndexes labels), + axis_grid_ = [] + } + where + vport r (PlotIndex i) = vmap (fi (plotindex_i imin) - 0.5, + fi (plotindex_i imax) + 0.5) r (fi i) + imin = minimum vs + imax = maximum vs + fi = fromIntegral :: Int -> Double + + +-- | Augment a list of values with index numbers for plotting +addIndexes :: [a] -> [(PlotIndex,a)] +addIndexes as = map (\(i,a) -> (PlotIndex i,a)) (zip [0..] as) + -- | A linear mapping of points in one range to another vmap :: PlotValue x => (x,x) -> Range -> x -> Double diff --git a/Graphics/Rendering/Chart/Grid.hs b/Graphics/Rendering/Chart/Grid.hs --- a/Graphics/Rendering/Chart/Grid.hs +++ b/Graphics/Rendering/Chart/Grid.hs @@ -195,7 +195,9 @@ Null -> return nullPickFn Empty -> return nullPickFn (Value (r,span,_)) -> do - let (Rect (Point x0 y0) (Point x1 y1)) = mkRect csizes loc span + let (Rect p0 p1) = mkRect csizes loc span + p0'@(Point x0 y0) <- alignc p0 + p1'@(Point x1 y1) <- alignc p1 preserveCState $ do c $ C.translate x0 y0 render r (x1-x0,y1-y0) diff --git a/Graphics/Rendering/Chart/Gtk.hs b/Graphics/Rendering/Chart/Gtk.hs --- a/Graphics/Rendering/Chart/Gtk.hs +++ b/Graphics/Rendering/Chart/Gtk.hs @@ -9,11 +9,21 @@ ) where import qualified Graphics.UI.Gtk as G +import qualified Graphics.UI.Gtk.Gdk.Events as G import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Types +import Data.List (isPrefixOf) +-- do action m for any keypress (except meta keys) +anyKey :: (Monad m) => m a -> G.Event -> m Bool +anyKey m (G.Key {G.eventKeyName=key}) + | any (`isPrefixOf` key) ignores = return True + | otherwise = m >> return True + where ignores = ["Shift","Control","Alt", + "Super","Meta","Hyper"] + renderableToWindow :: Renderable a -> Int -> Int -> IO () renderableToWindow chart windowWidth windowHeight = do G.unsafeInitGUIForThreadedRTS @@ -24,7 +34,7 @@ -- G.windowSetResizable window False G.widgetSetSizeRequest window windowWidth windowHeight -- press any key to quit - G.onKeyPress window $ const (do G.widgetDestroy window; return True) + G.onKeyPress window $ anyKey (G.widgetDestroy window) G.onDestroy window G.mainQuit G.onExpose canvas $ const (updateCanvas chart canvas) G.set window [G.containerChild G.:= canvas] diff --git a/Graphics/Rendering/Chart/Layout.hs b/Graphics/Rendering/Chart/Layout.hs --- a/Graphics/Rendering/Chart/Layout.hs +++ b/Graphics/Rendering/Chart/Layout.hs @@ -31,28 +31,30 @@ MAxisFn, defaultLayout1, - - mAxis, - noAxis, + linkAxes, + independentAxes, updateAllAxesStyles, - updateXAxesData, - updateYAxesData, - setForeground, + setLayout1Foreground, + defaultLayoutAxis, laxis_title_style, laxis_title, laxis_style, - laxis_data, + laxis_visible, + laxis_generate, + laxis_override, laxis_reverse, 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, @@ -80,8 +82,20 @@ laxis_title_style_ :: CairoFontStyle, laxis_title_ :: String, laxis_style_ :: AxisStyle, - laxis_data_ :: MAxisFn x, + -- | 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, + + -- | function that generates the axis data, based upon the + -- points plotted. The default value is 'autoAxis'. + laxis_generate_ :: AxisFn x, + + -- | function that can be used to override the generated axis data. + -- The default value is 'id'. + laxis_override_ :: AxisData x -> AxisData x, + -- | True if left to right (bottom to top) is to show descending values laxis_reverse_ :: Bool @@ -94,6 +108,7 @@ data Layout1 x y = Layout1 { layout1_background_ :: CairoFillStyle, + layout1_plot_background_ :: Maybe CairoFillStyle, layout1_title_ :: String, layout1_title_style_ :: CairoFontStyle, @@ -103,8 +118,12 @@ layout1_left_axis_ :: LayoutAxis y, layout1_right_axis_ :: LayoutAxis y, + -- | 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]), + layout1_margin_ :: Double, - layout1_plots_ :: [(String,Either (Plot x y) (Plot x y))], + layout1_plots_ :: [Either (Plot x y) (Plot x y)], layout1_legend_ :: Maybe(LegendStyle), -- | True if the grid is to be rendered on top of the Plots @@ -160,7 +179,10 @@ tstyle = laxis_title_style_ (af l) ttext = laxis_title_ (af l) - plots = tval $ plotsToRenderable l + plots = tval $ mfill (layout1_plot_background_ l) $ plotsToRenderable l + where + mfill Nothing = id + mfill (Just fs) = fillBackground fs (ba,la,ta,ra) = getAxes l baxis = tval $ maybe emptyRenderable (mapPickFn L1P_BottomAxis . axisToRenderable) ba @@ -176,8 +198,8 @@ legends = gridToRenderable (besideN [ tval $ mkLegend lefts, weights (1,1) $ tval $ emptyRenderable, tval $ mkLegend rights ]) - lefts = [ (s,p) | (s,Left p) <- (layout1_plots_ l) ] - rights = [ (s,p) | (s,Right p) <- (layout1_plots_ l) ] + lefts = [ p | (Left p) <- (layout1_plots_ l) ] + rights = [ p | (Right p) <- (layout1_plots_ l) ] mkLegend plots = case (layout1_legend_ l) of Nothing -> emptyRenderable @@ -195,12 +217,11 @@ } renderPlots :: Layout1 x y -> RectSize -> CRender (PickFn (Layout1Pick x y)) -renderPlots l sz@(w,h) = preserveCState $ do - -- render the plots - setClipRegion (Point 0 0) (Point w h) - +renderPlots l sz@(w,h) = do when (not (layout1_grid_last_ l)) renderGrids - local (const vectorEnv) $ do + preserveCState $ do + -- render the plots + setClipRegion (Point 0 0) (Point w h) mapM_ rPlot (layout1_plots_ l) when (layout1_grid_last_ l) renderGrids return nullPickFn @@ -208,8 +229,8 @@ where (bAxis,lAxis,tAxis,rAxis) = getAxes l - rPlot (_,Left p) = rPlot1 bAxis lAxis p - rPlot (_,Right p) = rPlot1 bAxis rAxis p + rPlot (Left p) = rPlot1 bAxis lAxis p + rPlot (Right p) = rPlot1 bAxis rAxis p rPlot1 (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p = let xrange = if xrev then (w, 0) else (0,w) @@ -234,43 +255,46 @@ where (xvals0,xvals1,yvals0,yvals1) = allPlottedValues (layout1_plots_ l) xvals = xvals0 ++ xvals1 - - -- Link the axes if either has no data, and use the axis that - -- actually has data to decide whether to reverse it - (yvals0',yrev0) = if null yvals0 then (yvals0++yvals1, layout1_right_axis_) - else (yvals0, layout1_left_axis_) - (yvals1',yrev1) = if null yvals1 then (yvals0++yvals1, layout1_left_axis_) - else (yvals1, layout1_right_axis_) + (yvals0',yvals1') = layout1_yaxes_control_ l (yvals0,yvals1) - bAxis = mkAxis E_Bottom layout1_bottom_axis_ layout1_bottom_axis_ xvals - tAxis = mkAxis E_Top layout1_top_axis_ layout1_bottom_axis_ xvals - lAxis = mkAxis E_Left layout1_left_axis_ yrev0 yvals0' - rAxis = mkAxis E_Right layout1_right_axis_ yrev1 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 axisf revf vals = do - adata <- laxis_data_ (axisf l) vals - return (AxisT t (laxis_style_ (axisf l)) (laxis_reverse_ (revf l)) adata) + 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) -allPlottedValues :: [(String,Either (Plot x y) (Plot x' y'))] -> ( [x], [x'], [y], [y'] ) +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,_) <- plot_all_points_ p] - yvals0 = [ y | (_, Left p) <- plots, (_,y) <- plot_all_points_ p] - xvals1 = [ x | (_, Right p) <- plots, (x,_) <- plot_all_points_ p] - yvals1 = [ y | (_, Right p) <- plots, (_,y) <- plot_all_points_ p] + xvals0 = [ x | (Left p) <- plots, (x,_) <- plot_all_points_ p] + yvals0 = [ y | (Left p) <- plots, (_,y) <- plot_all_points_ p] + xvals1 = [ x | (Right p) <- plots, (x,_) <- plot_all_points_ p] + yvals1 = [ y | (Right p) <- plots, (_,y) <- plot_all_points_ p] defaultLayout1 :: (PlotValue x,PlotValue y) => Layout1 x y defaultLayout1 = Layout1 { layout1_background_ = solidFillStyle white, + layout1_plot_background_ = Nothing, layout1_title_ = "", layout1_title_style_ = defaultFontStyle{font_size_=15, font_weight_=C.FontWeightBold}, - layout1_top_axis_ = defaultLayoutAxis, + layout1_top_axis_ = defaultLayoutAxis { + laxis_visible_ = const False + }, layout1_bottom_axis_ = defaultLayoutAxis, layout1_left_axis_ = defaultLayoutAxis, layout1_right_axis_ = defaultLayoutAxis, + layout1_yaxes_control_ = id, + layout1_margin_ = 10, layout1_plots_ = [], layout1_legend_ = Just defaultLegendStyle, @@ -282,22 +306,9 @@ laxis_title_style_ = defaultFontStyle{font_size_=10}, laxis_title_ = "", laxis_style_ = defaultAxisStyle, - laxis_data_ = mAxis autoAxis, - laxis_reverse_ = False -} - --- | Create an axis when there are points to be plotted against it. -mAxis :: PlotValue t => AxisFn t -> MAxisFn t -mAxis axisfn [] = Nothing -mAxis axisfn ps = Just (axisfn ps) - --- | Never create an axis -noAxis :: PlotValue t => LayoutAxis t -noAxis = LayoutAxis { - laxis_title_style_ = defaultFontStyle{font_size_=10}, - laxis_title_ = "", - laxis_style_ = defaultAxisStyle, - laxis_data_ = const Nothing, + laxis_visible_ = not.null, + laxis_generate_ = autoAxis, + laxis_override_ = id, laxis_reverse_ = False } @@ -313,20 +324,9 @@ (layout1_left_axis .> laxis_style ^: uf) . (layout1_right_axis .> laxis_style ^: uf) --- | Helper to update data member of both horizontal axes in a Layout1 -updateXAxesData :: (MAxisFn x -> MAxisFn x) -> Layout1 x y -> Layout1 x y -updateXAxesData uf = (layout1_top_axis .> laxis_data ^: uf) . - (layout1_bottom_axis .> laxis_data ^: uf) - --- | Helper to update data member of both vertical axes in a Layout1 -updateYAxesData :: (MAxisFn y -> MAxisFn y) -> Layout1 x y -> Layout1 x y -updateYAxesData uf = (layout1_left_axis .> laxis_data ^: uf) . - (layout1_right_axis .> laxis_data ^: uf) - - -- | Helper to set the forground color uniformly on a Layout1 -setForeground :: Color -> Layout1 x y -> Layout1 x y -setForeground fg = updateAllAxesStyles ( +setLayout1Foreground :: Color -> Layout1 x y -> Layout1 x y +setLayout1Foreground fg = updateAllAxesStyles ( (axis_line_style .> line_color ^= fg). (axis_label_style .> font_color ^= fg) ) @@ -334,3 +334,5 @@ . (layout1_legend ^: fmap (legend_label_style .> font_color ^= fg)) +linkAxes (ys1,ys2) = (ys1++ys2,ys1++ys2) +independentAxes (ys1,ys2) = (ys1,ys2) diff --git a/Graphics/Rendering/Chart/Legend.hs b/Graphics/Rendering/Chart/Legend.hs --- a/Graphics/Rendering/Chart/Legend.hs +++ b/Graphics/Rendering/Chart/Legend.hs @@ -35,7 +35,7 @@ legend_plot_size_ :: Double } -data Legend x y = Legend Bool LegendStyle [(String,Plot x y)] +data Legend x y = Legend Bool LegendStyle [Plot x y] instance ToRenderable (Legend x y) where toRenderable = setPickFn nullPickFn.legendToRenderable @@ -43,17 +43,22 @@ legendToRenderable :: Legend x y -> Renderable String legendToRenderable (Legend _ ls plots) = gridToRenderable grid where - grid = besideN $ intersperse ggap1 (map (tval.rf) (join_nub plots)) - rf (title,ps) = setPickFn (const (Just title)) (gridToRenderable grid1) + grid = besideN $ intersperse ggap1 (map (tval.rf) ps) + + ps :: [(String, [Rect -> CRender ()])] + ps = join_nub (concatMap plot_legend_ plots) + + rf (title,rfs) = gridToRenderable grid1 where - grid1 = besideN $ intersperse ggap2 (map rp ps) ++ [ggap2,gtitle] + grid1 = besideN $ intersperse ggap2 (map rp rfs) ++ [ggap2,gtitle] gtitle = tval $ lbl title - rp p = tval $ Renderable { + rp rfn = tval $ Renderable { minsize = return (legend_plot_size_ ls, 0), render = \(w,h) -> do - plot_render_legend_ p (Rect (Point 0 0) (Point w h)) + rfn (Rect (Point 0 0) (Point w h)) return nullPickFn } + ggap1 = tval $ spacer (legend_margin_ ls,0) ggap2 = tval $ spacer1 (lbl "X") lbl s = label (legend_label_style_ ls) HTA_Centre VTA_Centre s diff --git a/Graphics/Rendering/Chart/Plot.hs b/Graphics/Rendering/Chart/Plot.hs --- a/Graphics/Rendering/Chart/Plot.hs +++ b/Graphics/Rendering/Chart/Plot.hs @@ -18,6 +18,8 @@ -- * 'PlotFillBetween' -- -- * 'PlotErrBars' +-- +-- * 'PlotBars' -- -- These accessors are not shown in this API documentation. They have -- the same name as the field, but with the trailing underscore @@ -39,6 +41,10 @@ PlotLines(..), PlotFillBetween(..), ErrPoint(..), + PlotBars(..), + PlotBarsStyle(..), + PlotBarsSpacing(..), + symErrPoint, defaultPlotLineStyle, @@ -46,30 +52,45 @@ defaultPlotErrBars, defaultPlotFillBetween, defaultPlotLines, + defaultPlotBars, + plot_lines_title, plot_lines_style, plot_lines_values, plot_render, - plot_render_legend, + plot_legend, plot_all_points, + plot_points_title, plot_points_style, plot_points_values, + plot_fillbetween_title, plot_fillbetween_style, plot_fillbetween_values, + plot_errbars_title, plot_errbars_line_style, plot_errbars_tick_length, plot_errbars_overhang, plot_errbars_values, + plotBars, + plot_bars_style, + plot_bars_item_styles, + plot_bars_titles, + plot_bars_spacing, + plot_bars_reference, + plot_bars_values, + ) where import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types +import Graphics.Rendering.Chart.Axis import Control.Monad +import Data.List import Data.Accessor.Template -- | Interface to control plotting on a 2D area. @@ -79,9 +100,10 @@ -- render this plot into a chart. plot_render_ :: PointMapFn x y -> CRender (), - -- | Render a small sample of this plot into the given rectangle. - -- This is for used to generate a the legend a chart. - plot_render_legend_ :: Rect -> CRender (), + -- | Details for how to show this plot in a legend. For each item + -- the string is the text to show, and the function renders a + -- graphical sample of the plot + plot_legend_ :: [ (String, Rect -> CRender ()) ], -- | All of the model space coordinates to be plotted. These are -- used to autoscale the axes where necessary. @@ -97,6 +119,7 @@ -- | Value defining a series of (possibly disjointed) lines, -- and a style in which to render them data PlotLines x y = PlotLines { + plot_lines_title_ :: String, plot_lines_style_ :: CairoLineStyle, plot_lines_values_ :: [[(x,y)]] } @@ -105,7 +128,7 @@ instance ToPlot PlotLines where toPlot p = Plot { plot_render_ = renderPlotLines p, - plot_render_legend_ = renderPlotLegendLines p, + plot_legend_ = [(plot_lines_title_ p, renderPlotLegendLines p)], plot_all_points_ = concat (plot_lines_values_ p) } @@ -133,6 +156,7 @@ } defaultPlotLines = PlotLines { + plot_lines_title_ = "", plot_lines_style_ = defaultPlotLineStyle, plot_lines_values_ = [] } @@ -141,6 +165,7 @@ -- | Value defining a series of datapoints, and a style in -- which to render them data PlotPoints x y = PlotPoints { + plot_points_title_ :: String, plot_points_style_ :: CairoPointStyle, plot_points_values_ :: [(x,y)] } @@ -149,7 +174,7 @@ instance ToPlot PlotPoints where toPlot p = Plot { plot_render_ = renderPlotPoints p, - plot_render_legend_ = renderPlotLegendPoints p, + plot_legend_ = [(plot_points_title_ p, renderPlotLegendPoints p)], plot_all_points_ = plot_points_values_ p } @@ -170,6 +195,7 @@ (CairoPointStyle drawPoint) = (plot_points_style_ p) defaultPlotPoints = PlotPoints { + plot_points_title_ = "", plot_points_style_ =defaultPointStyle, plot_points_values_ = [] } @@ -178,6 +204,7 @@ -- coordinates, given common X coordinates. data PlotFillBetween x y = PlotFillBetween { + plot_fillbetween_title_ :: String, plot_fillbetween_style_ :: CairoFillStyle, plot_fillbetween_values_ :: [ (x, (y,y))] } @@ -186,7 +213,7 @@ instance ToPlot PlotFillBetween where toPlot p = Plot { plot_render_ = renderPlotFillBetween p, - plot_render_legend_ = renderPlotLegendFill p, + plot_legend_ = [(plot_fillbetween_title_ p, renderPlotLegendFill p)], plot_all_points_ = plotAllPointsFillBetween p } @@ -217,6 +244,7 @@ defaultPlotFillBetween = PlotFillBetween { + plot_fillbetween_title_ = "", plot_fillbetween_style_=solidFillStyle (Color 0.5 0.5 1.0), plot_fillbetween_values_=[] } @@ -244,6 +272,7 @@ -- | Value defining a series of error intervals, and a style in -- which to render them data PlotErrBars x y = PlotErrBars { + plot_errbars_title_ :: String, plot_errbars_line_style_ :: CairoLineStyle, plot_errbars_tick_length_ :: Double, plot_errbars_overhang_ :: Double, @@ -254,7 +283,7 @@ instance ToPlot PlotErrBars where toPlot p = Plot { plot_render_ = renderPlotErrBars p, - plot_render_legend_ = renderPlotLegendErrBars p, + plot_legend_ = [(plot_errbars_title_ p,renderPlotLegendErrBars p)], plot_all_points_ = concat [[((ev_low x),(ev_low y)), ((ev_high x),(ev_high y))] | ErrPoint x y <- plot_errbars_values_ p] @@ -301,6 +330,7 @@ dx = min ((p_x p2 - p_x p1)/6) ((p_y p2 - p_y p1)/2) defaultPlotErrBars = PlotErrBars { + plot_errbars_title_ = "", plot_errbars_line_style_ = solidLine 1 blue, plot_errbars_tick_length_ = 3, plot_errbars_overhang_ = 0, @@ -308,9 +338,145 @@ } ---------------------------------------------------------------------- + +class PlotValue a => BarsPlotValue a where + barsReference :: a + barsAdd :: a -> a -> a + +instance BarsPlotValue Double where + barsReference = 0 + barsAdd = (+) + +data PlotBarsStyle = BarsStacked | BarsClustered +data PlotBarsSpacing = BarsFixWidth Double + | BarsFixGap Double + +-- | Value describing how to plot a set of bars. +-- Note that the input data is typed [(x,[y])], ie for each x value +-- we plot several y values. Typically the size of each [y] list would +-- be the same. +data PlotBars x y = PlotBars { + -- | This value specifies whether each value from [y] should be + -- shown beside or above the previous value. + plot_bars_style_ :: PlotBarsStyle, + + -- | The style in which to draw each element of [y]. A fill style + -- is required, and if a linestyle is given, each bar will be + -- outlined. + plot_bars_item_styles_ :: [ (CairoFillStyle,Maybe CairoLineStyle) ], + + -- | The title of each element of [y]. These will be shown in the + -- legend. + plot_bars_titles_ :: [String], + + -- | This value controls how the widths of the bars are + -- calculated. Either the widths of the bars, or the gaps between + -- them can be fixed. + plot_bars_spacing_ :: PlotBarsSpacing, + + -- | The starting level for the chart (normally 0). + plot_bars_reference_ :: y, + + -- | The actual points to be plotted + plot_bars_values_ :: [ (x,[y]) ] +} + +defaultPlotBars :: BarsPlotValue y => PlotBars x y +defaultPlotBars = PlotBars { + plot_bars_style_ = BarsClustered, + plot_bars_item_styles_ = cycle istyles, + plot_bars_titles_ = [], + plot_bars_spacing_ = BarsFixGap 10, + plot_bars_values_ = [], + plot_bars_reference_ = barsReference + } + where + istyles = map mkstyle defaultColorSeq + mkstyle c = (solidFillStyle c,Just (solidLine 1.0 black)) + +plotBars :: (BarsPlotValue y) => PlotBars x y -> Plot x y +plotBars p = Plot { + plot_render_ = renderPlotBars p, + plot_legend_ = zip (plot_bars_titles_ p) (map renderPlotLegendBars (plot_bars_item_styles_ p)), + plot_all_points_ = allBarPoints p + } + +renderPlotBars :: BarsPlotValue y => PlotBars x y -> PointMapFn x y -> CRender () +renderPlotBars p pmap = case (plot_bars_style_ p) of + BarsClustered -> do forM_ vals clusteredBars + BarsStacked -> forM_ vals stackedBars + where + clusteredBars (x,ys) = preserveCState $ do + forM_ (zip3 [0,1..] ys styles) $ \(i, y, (fstyle,_)) -> do + setFillStyle fstyle + barPath (offset i) x yref0 y + c $ C.fill + forM_ (zip3 [0,1..] ys styles) $ \(i, y, (_,mlstyle)) -> do + whenJust mlstyle $ \lstyle -> do + setLineStyle lstyle + barPath (offset i) x yref0 y + c $ C.stroke + + offset i = fromIntegral (2*i-nys) * width/2 + + stackedBars (x,ys) = preserveCState $ do + let y2s = zip (yref0:stack ys) (stack ys) + forM_ (zip y2s styles) $ \((y0,y1), (fstyle,_)) -> do + setFillStyle fstyle + barPath (-width/2) x y0 y1 + c $ C.fill + forM_ (zip y2s styles) $ \((y0,y1), (_,mlstyle)) -> do + whenJust mlstyle $ \lstyle -> do + setLineStyle lstyle + barPath (-width/2) x y0 y1 + c $ C.stroke + + barPath xos x y0 y1 = do + let (Point x' y') = pmap (x,y1) + let (Point _ y0') = pmap (x,y0) + rectPath (Rect (Point (x'+xos) y0') (Point (x'+xos+width) y')) + + yref0 = plot_bars_reference_ p + vals = plot_bars_values_ p + width = case plot_bars_spacing_ p of + BarsFixGap gap -> case (plot_bars_style_ p) of + BarsClustered -> (minXInterval - gap) / fromIntegral nys + BarsStacked -> (minXInterval - gap) + BarsFixWidth width -> width + styles = plot_bars_item_styles_ p + + minXInterval = minimum $ zipWith (-) (tail xs) xs + where + xs = nub $ sort $ map (p_x.pmap) (allBarPoints p) + + nys = maximum [ length ys | (x,ys) <- vals ] + +whenJust :: (Monad m) => Maybe a -> (a -> m ()) -> m () +whenJust (Just a) f = f a +whenJust _ _ = return () + +allBarPoints :: (BarsPlotValue y) => PlotBars x y -> [(x,y)] +allBarPoints p = case (plot_bars_style_ p) of + BarsClustered -> concat [ (x,y0):[(x,y) | y <- ys ] | (x,ys) <- plot_bars_values_ p ] + BarsStacked -> concat [ (x,y0):[(x,y) | y <- stack ys ] | (x,ys) <- plot_bars_values_ p ] + where + y0 = plot_bars_reference_ p + +stack :: (BarsPlotValue y) => [y] -> [y] +stack ys = scanl1 barsAdd ys + + +renderPlotLegendBars :: (CairoFillStyle,Maybe CairoLineStyle) -> Rect -> CRender () +renderPlotLegendBars (fstyle,mlstyle) r@(Rect p1 p2) = do + setFillStyle fstyle + rectPath r + c $ C.fill + +---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor for each field $( deriveAccessors ''Plot ) $( deriveAccessors ''PlotLines ) $( deriveAccessors ''PlotPoints ) $( deriveAccessors ''PlotFillBetween ) $( deriveAccessors ''PlotErrBars ) +$( deriveAccessors ''PlotBars ) diff --git a/Graphics/Rendering/Chart/Renderable.hs b/Graphics/Rendering/Chart/Renderable.hs --- a/Graphics/Rendering/Chart/Renderable.hs +++ b/Graphics/Rendering/Chart/Renderable.hs @@ -185,12 +185,13 @@ renderableToSVGFile :: Renderable a -> Int -> Int -> FilePath -> IO () renderableToSVGFile = renderableToFile C.withSVGSurface -bitmapEnv = CEnv adjfn +bitmapEnv = CEnv (adjfn 0.5) (adjfn 0.0) where - adjfn (Point x y)= Point (adj x) (adj y) - adj x = (fromIntegral.round) x + 0.5 + adjfn offset (Point x y) = Point (adj x) (adj y) + where + adj v = (fromIntegral.round) v +offset -vectorEnv = CEnv id +vectorEnv = CEnv id id -- | Helper function for using a renderable, when we generate it -- in the CRender monad. diff --git a/Graphics/Rendering/Chart/Simple.hs b/Graphics/Rendering/Chart/Simple.hs --- a/Graphics/Rendering/Chart/Simple.hs +++ b/Graphics/Rendering/Chart/Simple.hs @@ -22,13 +22,13 @@ -- -- Examples: -- --- @renderableToWindow (toRenderable $ plotLayout $ plot [0,0.1..10] sin "sin(x)") 640 480@ +-- > renderableToWindow (toRenderable $ plotLayout $ plot [0,0.1..10] sin "sin(x)") 640 480 -- --- @plotWindow [0,1,3,4,8]] [12,15,1,5,8] "o" "points"@ +-- > plotWindow [0,1,3,4,8] [12,15,1,5,8] "o" "points" -- --- @plotPDF "foo.pdf" [0,0.1..10] sin "- " cos ". " cos "o"@ +-- > plotPDF "foo.pdf" [0,0.1..10] sin "- " cos ". " cos "o" -- --- @plotPS "foo.ps" [0,0.1..10] (sin.exp) "- " (sin.exp) "o-"@ +-- > plotPS "foo.ps" [0,0.1..10] (sin . exp) "- " (sin . exp) "o-" ----------------------------------------------------------------------------- module Graphics.Rendering.Chart.Simple( plot, PlotKind(..), xcoords, plotWindow, plotPDF, plotPS, @@ -64,48 +64,61 @@ ip [] = [] isIPY (IPY _ _) = True isIPY _ = False - toplot (IPX xs _, IPY ys yks) ind = map (\z -> (name yks, Left z)) plots + toplot (IPX xs _, IPY ys yks) ind = map Left plots where vs = zip xs ys plots = case catMaybes $ map plotas yks of - [] -> [toPlot $ defaultPlotLines - { plot_lines_values_ = [vs], + [] -> [toPlot $ defaultPlotLines + { plot_lines_title_ = name yks, + plot_lines_values_ = [vs], plot_lines_style_ = solidLine 1 (styleColor ind) }] - xs -> xs + xs -> xs plotas Solid = Just $ toPlot $ defaultPlotLines - { plot_lines_values_ = [vs], + { plot_lines_title_ = name yks, + plot_lines_values_ = [vs], plot_lines_style_ = solidLine 1 (styleColor ind) } plotas Dashed = Just $ toPlot $ defaultPlotLines - { plot_lines_values_ = [vs], + { plot_lines_title_ = name yks, + plot_lines_values_ = [vs], plot_lines_style_ = dashedLine 1 [10,10] (styleColor ind) } plotas Dotted = Just $ toPlot $ defaultPlotLines - { plot_lines_values_ = [vs], + { plot_lines_title_ = name yks, + plot_lines_values_ = [vs], plot_lines_style_ = dashedLine 1 [1,11] (styleColor ind) } plotas FilledCircle = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=filledCircles 4 (styleColor ind) } plotas HollowCircle = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=hollowCircles 5 1 (styleColor ind) } plotas Triangle = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=hollowPolygon 7 1 3 False (styleColor ind) } plotas DownTriangle = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=hollowPolygon 7 1 3 True (styleColor ind) } plotas Square = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=hollowPolygon 7 1 4 False (styleColor ind) } plotas Diamond = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=hollowPolygon 7 1 4 True (styleColor ind) } plotas Plus = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=plusses 7 1 (styleColor ind) } plotas Ex = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=exes 7 1 (styleColor ind) } plotas Star = Just $ toPlot $ defaultPlotPoints - { plot_points_values_ = vs, + { plot_points_title_ = name yks, + plot_points_values_ = vs, plot_points_style_=stars 7 1 (styleColor ind) } plotas Symbols = plotas (styleSymbol ind) plotas _ = Nothing diff --git a/Graphics/Rendering/Chart/Types.hs b/Graphics/Rendering/Chart/Types.hs --- a/Graphics/Rendering/Chart/Types.hs +++ b/Graphics/Rendering/Chart/Types.hs @@ -57,6 +57,7 @@ defaultColorSeq, Color(..), + color, setSourceColor, CairoLineStyle(..), @@ -91,6 +92,8 @@ CEnv(..), runCRender, c, + alignp, + alignc, line_width, line_color, @@ -128,6 +131,9 @@ c_b :: Double } +color :: Int -> Int -> Int -> Color +color ri gi bi = Color (fromIntegral ri/255) (fromIntegral gi/255) (fromIntegral bi/255) + -- | scale a vector by a constant vscale :: Double -> Vector -> Vector vscale c (Vector x y) = (Vector (x*c) (y*c)) @@ -168,14 +174,18 @@ -- | The environment present in the CRender Monad. data CEnv = CEnv { - -- | A transform applied immediately prior to values + -- | An adjustment applied immediately prior to points -- being displayed in device coordinates -- -- When device coordinates correspond to pixels, a cleaner -- image is created if this transform rounds to the nearest -- pixel. With higher-resolution output, this transform can -- just be the identity function. - cenv_point_alignfn :: Point -> Point + cenv_point_alignfn :: Point -> Point, + + -- | A adjustment applied immediately prior to coordinates + -- being transformed + cenv_coord_alignfn :: Point -> Point } -- | The reader monad containing context information to control @@ -245,6 +255,11 @@ alignfn <- fmap cenv_point_alignfn ask return (alignfn p) +alignc :: Point -> CRender Point +alignc p = do + alignfn <- fmap cenv_coord_alignfn ask + return (alignfn p) + lineTo p = do p' <- alignp p c $ C.lineTo (p_x p') (p_y p') @@ -266,15 +281,14 @@ c $ C.stroke strokeLines _ = return () --- | make a path from a rectable +-- | make a path from a rectangle rectPath :: Rect -> CRender () -rectPath (Rect (Point x1 y1) (Point x2 y2)) = c $ do - C.newPath - C.moveTo x1 y1 - C.lineTo x2 y1 - C.lineTo x2 y2 - C.lineTo x1 y2 - C.lineTo x1 y1 +rectPath (Rect p1@(Point x1 y1) p3@(Point x2 y2)) = do + c $ C.newPath + moveTo p1 >> lineTo p2 >> lineTo p3 >> lineTo p4 >> lineTo p1 + where + p2 = (Point x1 y2) + p4 = (Point x2 y1) setFontStyle f = do c $ C.selectFontFace (font_name_ f) (font_slant_ f) (font_weight_ f) diff --git a/tests/test.hs b/tests/test.hs --- a/tests/test.hs +++ b/tests/test.hs @@ -11,6 +11,10 @@ import Data.Time.LocalTime import Data.Accessor import Data.Accessor.Tuple +import Data.List(sort,nub,scanl1) +import qualified Data.Map as Map +import Debug.Trace +import Control.Monad import Prices data OutputType = Window | PNG | PS | PDF | SVG @@ -23,58 +27,87 @@ green1 = (Color 0.5 1 0.5) red1 = (Color 0.5 0.5 1) +fwhite = solidFillStyle white +fparchment = solidFillStyle (color 255 250 230) ---------------------------------------------------------------------- -test1 :: OutputType -> Renderable () -test1 otype = toRenderable layout +test1Layout otype = layout where am :: Double -> Double am x = (sin (x*3.14159/45) + 1) / 2 * (sin (x*3.14159/5)) sinusoid1 = plot_lines_values ^= [[ (x,(am x)) | x <- [0,(0.5)..400]]] $ plot_lines_style ^= solidLine lineWidth blue + $ plot_lines_title ^="am" $ defaultPlotLines sinusoid2 = plot_points_style ^= filledCircles 2 red $ plot_points_values ^= [ (x,(am x)) | x <- [0,7..400]] + $ plot_points_title ^="am points" $ defaultPlotPoints - layout = layout1_title ^= "Amplitude Modulation" - $ layout1_plots ^= [("am",Left (toPlot sinusoid1)), - ("am points", Left (toPlot sinusoid2))] + layout = layout1_plots ^= [Left (toPlot sinusoid1), + Left (toPlot sinusoid2)] + $ layout1_background ^= fparchment + $ layout1_plot_background ^= Just fwhite $ defaultLayout1 lineWidth = chooseLineWidth otype +test1 :: OutputType -> Renderable () +test1 otype = toRenderable layout + where + layout = layout1_title ^= "Amplitude Modulation" + $ (test1Layout otype) + test1a :: OutputType -> Renderable () -test1a otype = toRenderable layout +test1a otype = fillBackground fwhite $ (gridToRenderable t) where - am :: Double -> Double - am x = (sin (x*3.14159/45) + 1) / 2 * (sin (x*3.14159/5)) + t = weights (1,1) $ aboveN [ besideN [rf g1, rf g2, rf g3], + besideN [rf g4, rf g5, rf g6] ] - sinusoid1 = plot_lines_values ^= [[ (x,(am x)) | x <- [0,(0.5)..400]]] - $ plot_lines_style ^= solidLine lineWidth blue - $ defaultPlotLines + g1 = layout1_title ^= "minimal" + $ layout1_bottom_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) + $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) + $ test1Layout otype - sinusoid2 = plot_points_style ^= filledCircles 2 red - $ plot_points_values ^= [ (x,(am x)) | x <- [0,7..400]] - $ defaultPlotPoints + g2 = layout1_title ^= "with borders" + $ layout1_bottom_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) + $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) + $ layout1_top_axis ^: axisBorderOnly + $ layout1_right_axis ^: axisBorderOnly + $ test1Layout otype - axis = mAxis $ axisGridAtTicks.autoScaledAxis ( - la_nLabels ^= 2 - $ la_nTicks ^= 20 - $ defaultLinearAxis - ) + g3 = layout1_title ^= "default" + $ test1Layout otype - layout = layout1_title ^= "Amplitude Modulation" - $ updateXAxesData (const axis) - $ updateYAxesData (const axis) - $ layout1_plots ^= [("am",Left (toPlot sinusoid1)), - ("am points", Left (toPlot sinusoid2))] - $ defaultLayout1 + g4 = layout1_title ^= "tight grid" + $ layout1_left_axis ^: laxis_generate ^= axis + $ layout1_left_axis ^: laxis_override ^= axisGridAtTicks + $ layout1_bottom_axis ^: laxis_generate ^= axis + $ layout1_bottom_axis ^: laxis_override ^= axisGridAtTicks + $ test1Layout otype + where + axis = autoScaledAxis ( + la_nLabels ^= 5 + $ la_nTicks ^= 20 + $ defaultLinearAxis + ) - lineWidth = chooseLineWidth otype + g5 = layout1_title ^= "y linked" + $ layout1_yaxes_control ^= linkAxes + $ test1Layout otype + g6 = layout1_title ^= "everything" + $ layout1_yaxes_control ^= linkAxes + $ layout1_top_axis ^: laxis_visible ^= const True + $ test1Layout otype + + rf = tval.toRenderable + + axisBorderOnly = (laxis_visible ^= const True) + . (laxis_override ^= (axisGridHide.axisTicksHide.axisLabelsHide)) + ---------------------------------------------------------------------- test2 :: [(Int,Int,Int,Double,Double)] -> OutputType -> Renderable () test2 prices otype = toRenderable layout @@ -86,13 +119,14 @@ price1 = plot_lines_style ^= lineStyle blue $ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,v,_) <- prices]] + $ plot_lines_title ^= "price 1" $ defaultPlotLines price2 = plot_lines_style ^= lineStyle green $ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,_,v) <- prices]] + $ plot_lines_title ^= "price 2" $ defaultPlotLines - vaxis = mAxis $ axisGridNone.autoAxis bg = Color 0 0 0.25 fg = Color 1 1 1 fg1 = Color 0.0 0.0 0.15 @@ -100,12 +134,12 @@ layout = layout1_title ^="Price History" $ layout1_background ^= solidFillStyle bg $ updateAllAxesStyles (axis_grid_style ^= solidLine 1 fg1) - $ layout1_left_axis ^: laxis_data ^= vaxis - $ layout1_right_axis ^: laxis_data ^= vaxis - $ layout1_plots ^= [("price 1", Left (toPlot price1)), - ("price 2", Right (toPlot price2))] + $ layout1_left_axis ^: laxis_override ^= axisGridHide + $ layout1_right_axis ^: laxis_override ^= axisGridHide + $ layout1_bottom_axis ^: laxis_override ^= axisGridHide + $ layout1_plots ^= [Left (toPlot price1), Right (toPlot price2)] $ layout1_grid_last ^= False - $ setForeground fg + $ setLayout1Foreground fg $ defaultLayout1 date dd mm yyyy = (LocalTime (fromGregorian (fromIntegral yyyy) mm dd) midnight) @@ -117,15 +151,18 @@ price1 = plot_fillbetween_style ^= solidFillStyle green1 $ plot_fillbetween_values ^= [ (date d m y,(0,v2)) | (d,m,y,v1,v2) <- prices] + $ plot_fillbetween_title ^= "price 1" $ defaultPlotFillBetween price2 = plot_fillbetween_style ^= solidFillStyle red1 $ plot_fillbetween_values ^= [ (date d m y,(0,v1)) | (d,m,y,v1,v2) <- prices] + $ plot_fillbetween_title ^= "price 2" $ defaultPlotFillBetween layout = layout1_title ^= "Price History" - $ layout1_plots ^= [("price 1", Left (toPlot price1)), - ("price 2", Left (toPlot price2))] + $ layout1_grid_last ^= True + $ layout1_plots ^= [Left (toPlot price1), + Left (toPlot price2)] $ defaultLayout1 ---------------------------------------------------------------------- @@ -135,9 +172,11 @@ points = plot_points_style ^= filledCircles 3 red $ plot_points_values ^= [ (x, LogValue (10**x)) | x <- [0.5,1,1.5,2,2.5] ] + $ plot_points_title ^= "values" $ defaultPlotPoints lines = plot_lines_values ^= [ [(x, LogValue (10**x)) | x <- [0,3]] ] + $ plot_lines_title ^= "values" $ defaultPlotLines layout = layout1_title ^= "Log/Linear Example" @@ -145,8 +184,7 @@ $ layout1_bottom_axis ^: laxis_reverse ^= xrev $ layout1_left_axis ^: laxis_title ^= "vertical" $ layout1_left_axis ^: laxis_reverse ^= yrev - $ layout1_plots ^= [("values",Left (toPlot points)), - ("values",Left (toPlot lines)) ] + $ layout1_plots ^= [Left (toPlot points), Left (toPlot lines) ] $ defaultLayout1 ---------------------------------------------------------------------- @@ -159,14 +197,16 @@ layout n t = layout1_title ^= "Simulation of betting on a biased coin" $ layout1_plots ^= [ - ("f=0.05", Left (toPlot (plot s1 n 0 (t 0.05)))), - ("f=0.1", Left (toPlot (plot s2 n 0 (t 0.1))))] + Left (toPlot (plot "f=0.05" s1 n 0 (t 0.05))), + Left (toPlot (plot "f=0.1" s2 n 0 (t 0.1))) + ] $ defaultLayout1 - plot s n m t = plot_lines_style ^= s - $ plot_lines_values ^= + plot tt s n m t = plot_lines_style ^= s + $ plot_lines_values ^= [[(fromIntegral x, LogValue y) | (x,y) <- filter (\(x,_)->x `mod` (m+1)==0) $ take n $ zip [0..] t]] + $ plot_lines_title ^= tt $ defaultPlotLines b = 0.1 @@ -203,18 +243,21 @@ vals :: [(Double,Double,Double,Double)] vals = [ (x,sin (exp x),sin x/2,cos x/10) | x <- [1..20]] bars = plot_errbars_values ^= [symErrPoint x y dx dy | (x,y,dx,dy) <- vals] + $ plot_errbars_title ^="test" $ defaultPlotErrBars points = plot_points_style ^= filledCircles 2 red $ plot_points_values ^= [(x,y) | (x,y,dx,dy) <- vals] + $ plot_points_title ^= "test" $ defaultPlotPoints layout = layout1_title ^= "errorbars example" - $ layout1_plots ^= [("test",Left (toPlot bars)), - ("test",Left (toPlot points))] + $ layout1_plots ^= [Left (toPlot bars), + Left (toPlot points)] $ defaultLayout1 ---------------------------------------------------------------------- + test8 :: OutputType -> Renderable () test8 otype = toRenderable layout where @@ -227,6 +270,65 @@ $ defaultPieLayout ---------------------------------------------------------------------- + + +test9 :: OutputType -> Renderable () +test9 otype = fillBackground fwhite $ (gridToRenderable t) + where + t = weights (1,1) $ aboveN [ besideN [rf g0, rf g1, rf g2], + besideN [rf g3, rf g4, rf g5] ] + + g0 = layout "clustered 1" + $ plot_bars_style ^= BarsClustered + $ plot_bars_spacing ^= BarsFixWidth 25 + $ bars1 + + g1 = layout "clustered / fix width " + $ plot_bars_style ^= BarsClustered + $ plot_bars_spacing ^= BarsFixWidth 25 + $ bars2 + + g2 = layout "clustered / fix gap " + $ plot_bars_style ^= BarsClustered + $ plot_bars_spacing ^= BarsFixGap 10 + $ bars2 + + g3 = layout "stacked 1" + $ plot_bars_style ^= BarsStacked + $ plot_bars_spacing ^= BarsFixWidth 25 + $ bars1 + + g4 = layout "stacked / fix width" + $ plot_bars_style ^= BarsStacked + $ plot_bars_spacing ^= BarsFixWidth 25 + $ bars2 + + g5 = layout "stacked / fix gap" + $ plot_bars_style ^= BarsStacked + $ plot_bars_spacing ^= BarsFixGap 10 + $ bars2 + + rf = tval.toRenderable + + alabels = [ "Jun", "Jul", "Aug", "Sep", "Oct" ] + + + layout title bars = layout1_title ^= title + $ layout1_bottom_axis ^: laxis_generate ^= autoIndexAxis alabels + $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) + $ layout1_plots ^= [ Left (plotBars bars) ] + $ defaultLayout1 :: Layout1 PlotIndex Double + + bars1 = plot_bars_titles ^= ["Cash"] + $ plot_bars_values ^= addIndexes [[20],[45],[30],[70]] + $ defaultPlotBars + + bars2 = plot_bars_titles ^= ["Cash","Equity"] + $ plot_bars_values ^= addIndexes [[20,45],[45,30],[30,20],[70,25]] + $ defaultPlotBars + + +---------------------------------------------------------------------- -- a quick test to display labels with all combinations -- of anchors misc1 rot otype = fillBackground fwhite $ (gridToRenderable t) @@ -266,6 +368,7 @@ , ("test6", test6) , ("test7", test7) , ("test8", test8) + , ("test9", test9) , ("misc1", misc1 0) , ("misc1a", misc1 45) ]