Chart 0.16 → 0.17

raw patch · 4 files changed

+158/−83 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Chart.cabal +6/−2
• Graphics/Rendering/Chart/Grid.hs +13/−14
• Graphics/Rendering/Chart/Layout.hs +111/−57
• tests/all_tests.hs +28/−10

@@ -1,11 +1,11 @@ Name: Chart-Version: 0.16+Version: 0.17 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2010 Author: Tim Docker <tim@dockerz.net> Maintainer: Tim Docker <tim@dockerz.net>-Homepage: http://www.dockerz.net/software/chart.html+Homepage: https://github.com/timbod7/haskell-chart/wiki Synopsis: A library for generating 2D Charts and Plots Description: A library for generating 2D Charts and Plots, based upon the cairo graphics library. Category: Graphics@@ -71,3 +71,7 @@         Graphics.Rendering.Chart.Plot.Pie,         Graphics.Rendering.Chart.Plot.Points         Graphics.Rendering.Chart.SparkLine++source-repository head+  type:     git+  location: https://github.com/timbod7/haskell-chart

@@ -18,10 +18,10 @@     width, height,     gridToRenderable,     weights,-    fullRowAbove,-    fullRowBelow,-    fullColLeft,-    fullColRight,+    aboveWide,+    wideAbove,+    tallBeside,+    besideTall,     fullOverlayUnder,     fullOverlayOver ) where@@ -101,25 +101,24 @@ above t1 t2  = Above t1 t2 size   where size = (max (width t1) (width t2), height t1 + height t2) --- | A value placed above the grid, occupying 1 row with the same---   horizontal span as the grid.-fullRowAbove :: a -> Double -> Grid a -> Grid a-fullRowAbove a w g = (weights (0,w) $ tspan a (width g,1)) `above` g+-- | A value occupying 1 row with the same  horizontal span as the grid.+wideAbove :: a -> Grid a -> Grid a+wideAbove a g = (weights (0,0) $ tspan a (width g,1)) `above` g  -- | A value placed below the grid, occupying 1 row with the same --   horizontal span as the grid.-fullRowBelow :: a -> Double -> Grid a -> Grid a-fullRowBelow a w g = g `above` (weights (0,w) $ tspan a (width g,1))+aboveWide :: Grid a -> a -> Grid a+aboveWide g a = g `above` (weights (0,0) $ tspan a (width g,1))  -- | A value placed to the left of the grid, occupying 1 column with --   the same vertical span as the grid.-fullColLeft  :: a -> Double -> Grid a -> Grid a-fullColLeft  a w g = (weights (w,0) $ tspan a (1,height g)) `beside` g+tallBeside  :: a -> Grid a -> Grid a+tallBeside  a g = (weights (0,0) $ tspan a (1,height g)) `beside` g  -- | A value placed to the right of the grid, occupying 1 column with --   the same vertical span as the grid.-fullColRight :: a -> Double -> Grid a -> Grid a-fullColRight a w g = g `beside` (weights (w,0) $ tspan a (1,height g))+besideTall :: Grid a -> a -> Grid a+besideTall g a = g `beside` (weights (0,0) $ tspan a (1,height g))  -- | A value placed under a grid, with the same span as the grid. fullOverlayUnder :: a -> Grid a -> Grid a

@@ -11,6 +11,8 @@ -- (see 'Data.Accessor') for each field of the following data types: -- --     * 'Layout1'+-- +--     * 'StackedLayouts' -- --     * 'LayoutAxis' --@@ -23,12 +25,14 @@ -- @ -- -{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# OPTIONS_GHC -XTemplateHaskell -XExistentialQuantification #-}  module Graphics.Rendering.Chart.Layout(     Layout1(..),     LayoutAxis(..),     Layout1Pick(..),+    StackedLayouts(..),+    StackedLayout(..),     MAxisFn,      defaultLayout1,@@ -62,9 +66,12 @@     layout1_legend,     layout1_grid_last, -    renderLayout1sStacked,-    AnyLayout1(),-    withAnyOrdinate+    defaultStackedLayouts,+    slayouts_layouts,+    slayouts_compress_xlabels,+    slayouts_compress_legend,++    renderStackedLayouts,   ) where  import qualified Graphics.Rendering.Cairo as C@@ -154,43 +161,76 @@ instance (Ord x, Ord y) => ToRenderable (Layout1 x y) where     toRenderable = setPickFn nullPickFn.layout1ToRenderable --- | Encapsulates a 'Layout1' with a fixed abscissa type but---   arbitrary ordinate type.-data AnyLayout1 x = AnyLayout1 {-    background       :: CairoFillStyle,-    titleRenderable  :: Renderable (),-    plotAreaGrid     :: Grid (Renderable ()),-    legendRenderable :: Renderable (),-    margin           :: Double-  }+type LegendItem = (String,Rect -> CRender ()) -withAnyOrdinate :: (Ord x,Ord y) => Layout1 x y -> AnyLayout1 x-withAnyOrdinate l = AnyLayout1 {-    background       = layout1_background_ l,-    titleRenderable  = mapPickFn (const ()) $ layout1TitleToRenderable l,-    plotAreaGrid     = fmap (mapPickFn (const ())) $ layout1PlotAreaToGrid l,-    legendRenderable = mapPickFn (const ()) $ layout1LegendsToRenderable l,-    margin           = layout1_margin_ l-  }+-- | A layout with it's y type hidded, so that it can be stacked+-- with other layouts (with differing y types)+data StackedLayout x = forall y . Ord y => StackedLayout (Layout1 x y) +-- | A holder for a set of vertically stacked layouts+data StackedLayouts x = StackedLayouts {+      slayouts_layouts_ :: [StackedLayout x],+      slayouts_compress_xlabels_ :: Bool,+      slayouts_compress_legend_ :: Bool+} --- | Render several layouts with the same abscissa type stacked so that their---   origins and axis titles are aligned horizontally with respect to each---   other.  The exterior margins and background are taken from the first---   element.-renderLayout1sStacked :: (Ord x) => [AnyLayout1 x] -> Renderable ()-renderLayout1sStacked []        = emptyRenderable-renderLayout1sStacked ls@(l1:_) = gridToRenderable g+defaultStackedLayouts :: StackedLayouts x+defaultStackedLayouts = StackedLayouts [] True 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 ()+renderStackedLayouts (StackedLayouts{slayouts_layouts_=[]}) = emptyRenderable+renderStackedLayouts slp@(StackedLayouts{slayouts_layouts_=sls@(sl1:_)}) = gridToRenderable g   where-    g = fullOverlayUnder (fillBackground (background l1) emptyRenderable)-        $ addMarginsToGrid (lm,lm,lm,lm)-        $ aboveN [ fullRowAbove (titleRenderable l) 0 (-                       fullRowBelow (legendRenderable l) 0-                           (plotAreaGrid l))-                 | l <- ls ]+    g = fullOverlayUnder (fillBackground bg emptyRenderable)+      $ foldr (above.mkGrid) nullt (zip sls [0,1..])+      +    mkGrid ((StackedLayout l),i)+        = (noPickFn $ layout1TitleToRenderable l)+          `wideAbove`+          (addMarginsToGrid (lm,lm,lm,lm) $ mkPlotArea baxis taxis)+          `aboveWide`+          (if showLegend then noPickFn $ renderLegend l legenditems else emptyRenderable) -    lm = margin l1+      where+        legenditems = case (slayouts_compress_legend_ slp,isBottomPlot) of+            (False,_) -> getLegendItems l+            (True,True) -> alllegendItems+            (True,False) -> ([],[]) +        mkPlotArea bx tx = fmap (mapPickFn (const ()))+                         $ layout1PlotAreaToGrid l{layout1_bottom_axis_=bx,layout1_top_axis_=tx}++        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_=[]}+        }++    bg = (\(StackedLayout l) -> layout1_background_ l) sl1+    +    all_xvals = concatMap (\(StackedLayout l) -> getLayout1XVals l) sls++    alllegendItems = (concatMap (fst.legendItems) sls, concatMap (snd.legendItems) sls)+    legendItems (StackedLayout l) = (getLegendItems 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 [@@ -231,15 +271,25 @@                   (layout1_title_ l)     lm    = layout1_margin_ l -layout1LegendsToRenderable :: (Ord x, Ord y) =>-                              Layout1 x y -> Renderable (Layout1Pick x y)-layout1LegendsToRenderable l = gridToRenderable g+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+++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 ]-    lefts  = concat [ plot_legend_ p | (Left p ) <- (layout1_plots_ l) ]-    rights = concat [ plot_legend_ p | (Right p) <- (layout1_plots_ l) ]      lm     = layout1_margin_ l @@ -248,38 +298,41 @@         Just ls ->  case filter ((/="").fst) vals of             []  -> emptyRenderable ;             lvs -> addMargins (0,lm,lm,lm) $-                       mapPickFn L1P_Legend $-                                 legendToRenderable (Legend ls lvs)+                       mapPickFn L1P_Legend $ legendToRenderable (Legend ls lvs) +layout1LegendsToRenderable :: (Ord x, Ord y) =>+                              Layout1 x y -> Renderable (Layout1Pick x y)+layout1LegendsToRenderable l = renderLegend l (getLegendItems l)+ layout1PlotAreaToGrid :: (Ord x, Ord y) =>                           Layout1 x y -> Grid (Renderable (Layout1Pick x y)) layout1PlotAreaToGrid l = layer2 `overlay` layer1   where     layer1 = aboveN-         [ besideN [er,     er,    er   ]-         , besideN [er,     er,    er   ]-         , besideN [er,     er,    weights (1,1) plots ]+         [ besideN [er,     er,  er,    er   ]+         , besideN [er,     er,  er,    er   ]+         , besideN [er,     er,  er,    weights (1,1) plots ]          ]      layer2 = aboveN-         [ besideN [er,     er,    ttitle, er,    er       ]-         , besideN [er,     tl,    taxis,  tr,    er       ]-         , besideN [ltitle, laxis, er,     raxis, rtitle   ]-         , besideN [er,     bl,    baxis,  br,    er       ]-         , besideN [er,     er,    btitle, er,    er       ]+         [ besideN [er,     er,  er,    ttitle, er,    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 = atitle HTA_Right  VTA_Centre 270 layout1_left_axis_   L1P_LeftAxisTitle-    rtitle = atitle HTA_Left   VTA_Centre 270 layout1_right_axis_  L1P_RightAxisTitle+    (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 ha va rot af pf = if ttext == "" then er-                             else tval $ mapPickFn pf-                                       $ rlabel tstyle ha va rot ttext+    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) @@ -438,6 +491,7 @@ -- for each field. $( deriveAccessors ''Layout1 ) $( deriveAccessors ''LayoutAxis )+$( deriveAccessors ''StackedLayouts )  -- | Helper to update all axis styles on a Layout1 simultaneously. updateAllAxesStyles :: (AxisStyle -> AxisStyle) -> Layout1 x y -> Layout1 x y

@@ -216,8 +216,7 @@ ------------------------------------------------------------------------------- -- A quick test of stacked layouts -test11 :: OutputType -> Renderable ()-test11 otype = renderLayout1sStacked [withAnyOrdinate layout1, withAnyOrdinate layout2]+test11_ f = f layout1 layout2   where     vs1 :: [(Int,Int)]     vs1 = [ (2,2), (3,40), (8,400), (12,60) ]@@ -225,24 +224,42 @@     vs2 :: [(Int,Double)]     vs2 = [ (0,0.7), (3,0.35), (4,0.25), (7, 0.6), (10,0.4) ] -    allx = map fst vs1 ++ map fst vs2-    extendRange = PlotHidden allx []-     plot1 = plot_points_style ^= filledCircles 5 (opaque red)           $ plot_points_values ^= vs1+          $ plot_points_title ^= "spots"           $ defaultPlotPoints -    layout1 = layout1_title ^= "Integer Axis"- 	   $ layout1_plots ^= [Left (toPlot plot1), Left (toPlot extendRange)]+    layout1 = layout1_title ^= "Multi typed stack"+ 	   $ layout1_plots ^= [Left (toPlot plot1)]+           $ layout1_left_axis ^: laxis_title ^= "integer values"            $ defaultLayout1      plot2 = plot_lines_values ^= [vs2]+          $ plot_lines_title ^= "lines"           $ defaultPlotLines -    layout2 = layout1_title ^= "Float Axis"- 	   $ layout1_plots ^= [Left (toPlot plot2), Left (toPlot extendRange)]+    layout2 = layout1_plots ^= [Left (toPlot plot2)]+           $ layout1_left_axis ^: laxis_title ^= "double values"            $ defaultLayout1 +test11a :: OutputType -> Renderable ()+test11a otype = test11_ f+   where+     f l1 l2 = renderStackedLayouts +             $ slayouts_layouts ^= [StackedLayout l1, StackedLayout l2]+             $ slayouts_compress_xlabels ^= False+             $ slayouts_compress_legend ^= False+             $ defaultStackedLayouts+ +test11b :: OutputType -> Renderable ()+test11b otype = test11_ f+   where+     f l1 l2 = renderStackedLayouts +             $ slayouts_layouts ^= [StackedLayout l1, StackedLayout l2]+             $ slayouts_compress_xlabels ^= True+             $ slayouts_compress_legend ^= True+             $ defaultStackedLayouts+ ------------------------------------------------------------------------------- -- More of an example that a test: -- configuring axes explicitly configured axes@@ -371,7 +388,8 @@      , ("test9l", stdSize, test9 BarsLeft)      , ("test9r", stdSize, test9 BarsRight)      , ("test10", stdSize, test10 prices1)-     , ("test11", stdSize, test11)+     , ("test11a", stdSize, test11a)+     , ("test11b", stdSize, test11b)      , ("test12", stdSize, test12)      , ("test13", stdSize, test13)      , ("test14", stdSize, \o -> Test14.chart (chooseLineWidth o) )