Chart 0.9 → 0.10
raw patch · 11 files changed
+527/−166 lines, 11 files
Files
- Chart.cabal +2/−2
- Graphics/Rendering/Chart/Axis.hs +49/−4
- Graphics/Rendering/Chart/Grid.hs +3/−1
- Graphics/Rendering/Chart/Gtk.hs +11/−1
- Graphics/Rendering/Chart/Layout.hs +70/−68
- Graphics/Rendering/Chart/Legend.hs +11/−6
- Graphics/Rendering/Chart/Plot.hs +174/−8
- Graphics/Rendering/Chart/Renderable.hs +5/−4
- Graphics/Rendering/Chart/Simple.hs +33/−20
- Graphics/Rendering/Chart/Types.hs +24/−10
- tests/test.hs +145/−42
Chart.cabal view
@@ -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 <tim@dockerz.net> Maintainer: Tim Docker <tim@dockerz.net> Homepage: http://www.dockerz.net/software/chart.html
Graphics/Rendering/Chart/Axis.hs view
@@ -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
Graphics/Rendering/Chart/Grid.hs view
@@ -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)
Graphics/Rendering/Chart/Gtk.hs view
@@ -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]
Graphics/Rendering/Chart/Layout.hs view
@@ -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)
Graphics/Rendering/Chart/Legend.hs view
@@ -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
Graphics/Rendering/Chart/Plot.hs view
@@ -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 )
Graphics/Rendering/Chart/Renderable.hs view
@@ -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.
Graphics/Rendering/Chart/Simple.hs view
@@ -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
Graphics/Rendering/Chart/Types.hs view
@@ -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)
tests/test.hs view
@@ -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) ]