Chart 0.13.1 → 0.14

raw patch · 47 files changed

+3188/−1846 lines, 47 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Chart.cabal +34/−9
• Graphics/Rendering/Chart.hs +3/−7
• Graphics/Rendering/Chart/AreaSpots.hs +0/−107
• Graphics/Rendering/Chart/Axis.hs +12/−759
• Graphics/Rendering/Chart/Axis/Floating.hs +224/−0
• Graphics/Rendering/Chart/Axis/Indexed.hs +50/−0
• Graphics/Rendering/Chart/Axis/Int.hs +73/−0
• Graphics/Rendering/Chart/Axis/LocalTime.hs +273/−0
• Graphics/Rendering/Chart/Axis/Types.hs +405/−0
• Graphics/Rendering/Chart/Axis/Unit.hs +30/−0
• Graphics/Rendering/Chart/Grid.hs +13/−1
• Graphics/Rendering/Chart/Gtk.hs +3/−1
• Graphics/Rendering/Chart/Layout.hs +34/−7
• Graphics/Rendering/Chart/Legend.hs +5/−2
• Graphics/Rendering/Chart/Pie.hs +0/−228
• Graphics/Rendering/Chart/Plot.hs +25/−667
• Graphics/Rendering/Chart/Plot/Annotation.hs +80/−0
• Graphics/Rendering/Chart/Plot/AreaSpots.hs +202/−0
• Graphics/Rendering/Chart/Plot/Bars.hs +225/−0
• Graphics/Rendering/Chart/Plot/Candle.hs +165/−0
• Graphics/Rendering/Chart/Plot/ErrBars.hs +132/−0
• Graphics/Rendering/Chart/Plot/FillBetween.hs +84/−0
• Graphics/Rendering/Chart/Plot/Hidden.hs +41/−0
• Graphics/Rendering/Chart/Plot/Lines.hs +109/−0
• Graphics/Rendering/Chart/Plot/Pie.hs +224/−0
• Graphics/Rendering/Chart/Plot/Points.hs +75/−0
• Graphics/Rendering/Chart/Plot/Types.hs +83/−0
• Graphics/Rendering/Chart/Renderable.hs +12/−15
• Graphics/Rendering/Chart/Simple.hs +9/−1
• Graphics/Rendering/Chart/Types.hs +61/−0
• tests/ExampleStocks.hs +219/−0
• tests/Prices.hs +86/−6
• tests/Test1.hs +2/−2
• tests/Test14.hs +2/−2
• tests/Test14a.hs +50/−0
• tests/Test15.hs +2/−2
• tests/Test17.hs +82/−0
• tests/Test2.hs +2/−2
• tests/Test3.hs +2/−2
• tests/Test4.hs +2/−2
• tests/Test5.hs +2/−2
• tests/Test6.hs +2/−2
• tests/Test7.hs +2/−2
• tests/Test8.hs +2/−2
• tests/Test9.hs +2/−2
• tests/TestParametric.hs +2/−2
• tests/all_tests.hs +41/−12

@@ -1,8 +1,8 @@ Name: Chart-Version: 0.13.1+Version: 0.14 License: BSD3 License-file: LICENSE-Copyright: Tim Docker, 2006-2009+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@@ -24,32 +24,57 @@      tests/Test8.hs,      tests/Test9.hs,      tests/Test14.hs,+     tests/Test14a.hs,      tests/Test15.hs,+     tests/Test17.hs,      tests/TestParametric.hs,           tests/Prices.hs+     tests/ExampleStocks.hs  flag splitbase   description: Choose the new smaller, split-up base package. +flag gtk+  description: If gtk2hs is available, add extra API functions to use it.+  default: True+ library   if flag(splitbase)     Build-depends: base >= 3 && < 5, old-locale, time, mtl, array   else     Build-depends: base < 3-  Build-depends: gtk >= 0.9.11, cairo >= 0.9.11, time, mtl, array, data-accessor == 0.2.*, +  Build-depends: cairo >= 0.9.11, time, mtl, array, data-accessor == 0.2.*,                   data-accessor-template >= 0.2.1.1 && < 0.3, colour >= 2.2.1 +  if flag(gtk)+    build-depends: gtk >= 0.9.11+    exposed-modules: Graphics.Rendering.Chart.Gtk+    cpp-options: -DHAVE_GTK=1+   Exposed-modules:         Graphics.Rendering.Chart,-        Graphics.Rendering.Chart.Gtk,         Graphics.Rendering.Chart.Types,         Graphics.Rendering.Chart.Renderable,         Graphics.Rendering.Chart.Axis,+        Graphics.Rendering.Chart.Axis.Floating,+        Graphics.Rendering.Chart.Axis.Indexed,+        Graphics.Rendering.Chart.Axis.Int,+        Graphics.Rendering.Chart.Axis.LocalTime,+        Graphics.Rendering.Chart.Axis.Types,+        Graphics.Rendering.Chart.Axis.Unit,         Graphics.Rendering.Chart.Layout,         Graphics.Rendering.Chart.Legend,-        Graphics.Rendering.Chart.Plot,-        Graphics.Rendering.Chart.Pie,         Graphics.Rendering.Chart.Simple,-        Graphics.Rendering.Chart.Grid-        Graphics.Rendering.Chart.AreaSpots-+        Graphics.Rendering.Chart.Grid,+        Graphics.Rendering.Chart.Plot,+        Graphics.Rendering.Chart.Plot.Types,+        Graphics.Rendering.Chart.Plot.Annotation,+        Graphics.Rendering.Chart.Plot.AreaSpots,+        Graphics.Rendering.Chart.Plot.Bars,+        Graphics.Rendering.Chart.Plot.Candle,+        Graphics.Rendering.Chart.Plot.ErrBars,+        Graphics.Rendering.Chart.Plot.FillBetween,+        Graphics.Rendering.Chart.Plot.Hidden,+        Graphics.Rendering.Chart.Plot.Lines,+        Graphics.Rendering.Chart.Plot.Pie,+        Graphics.Rendering.Chart.Plot.Points

@@ -9,15 +9,15 @@ -- The basic model is that you define a value of type 'Renderable', -- typically by applying 'toRenderable' to some other value. This -- 'Renderable' is then actually displayed or output by calling either--- 'renderableToPNGFile', or 'Graphics.Rendering.Chart.Gtk.renderableToWindow'.+-- 'renderableToPNGFile', or 'renderableToWindow'. -- -- Currently, there are two kinds of 'Renderable' for displaying charts: -- --     * a standard two axes chart can be is created by applying---      'toRenderable' to a value of type 'Graphics.Rendering.Chart.Layout.Layout1'+--      'toRenderable' to a value of type 'Layout1' -- --     *  a pie chart can be is created by applying---      'toRenderable' to a value of type 'Graphics.Rendering.Chart.Pie.PieLayout'+--      'toRenderable' to a value of type 'PieLayout' -- -- Multiple Renderables can be composed using the "Graphics.Rendering.Chart.Grid" module. --@@ -38,8 +38,6 @@     module Graphics.Rendering.Chart.Axis,     module Graphics.Rendering.Chart.Plot,     module Graphics.Rendering.Chart.Legend,-    module Graphics.Rendering.Chart.AreaSpots,-    module Graphics.Rendering.Chart.Pie,  ) where @@ -49,5 +47,3 @@ import Graphics.Rendering.Chart.Axis import Graphics.Rendering.Chart.Plot import Graphics.Rendering.Chart.Legend-import Graphics.Rendering.Chart.Pie-import Graphics.Rendering.Chart.AreaSpots

@@ -1,107 +0,0 @@--- |--- Module     :  Graphics.Rendering.Chart.AreaSpots--- Copyright  :  (c) Malcolm Wallace 2009--- License    :  BSD-style (see COPYRIGHT file)------ Area spots are a collection of unconnected filled circles,--- with x,y position, and an independent z value to be represented--- by the relative area of the spots.--{-# OPTIONS_GHC -XTemplateHaskell #-}--module Graphics.Rendering.Chart.AreaSpots-  ( AreaSpots(..)-  , defaultAreaSpots--  , area_spots_title-  , area_spots_linethick-  , area_spots_linecolour-  , area_spots_fillcolour-  , area_spots_max_radius-  , area_spots_values-  ) where--import qualified Graphics.Rendering.Cairo as C--import Graphics.Rendering.Chart.Types-import Graphics.Rendering.Chart.Plot-import Graphics.Rendering.Chart.Axis-import Data.Accessor.Template-import Data.Colour-import Data.Colour.Names--import Control.Monad---- stuff that belongs in Data.Tuple-fst3 (a,_,_) = a-snd3 (_,a,_) = a-thd3 (_,_,a) = a----- | A collection of unconnected spots, with x,y position, and an---   independent z value to be represented by the area of the spot.-data AreaSpots z x y = AreaSpots-  { area_spots_title_      :: String-  , area_spots_linethick_  :: Double-  , area_spots_linecolour_ :: AlphaColour Double-  , area_spots_fillcolour_ :: AlphaColour Double-  , area_spots_max_radius_ :: Double	-- ^ the largest size of spot-  , area_spots_values_     :: [(x,y,z)]-  }--defaultAreaSpots :: AreaSpots z x y-defaultAreaSpots = AreaSpots-  { area_spots_title_      = ""-  , area_spots_linethick_  = 0.1-  , area_spots_linecolour_ = opaque blue-  , area_spots_fillcolour_ = flip withOpacity 0.2 blue-  , area_spots_max_radius_ = 20  -- in pixels-  , area_spots_values_     = []-  }--instance (PlotValue z) => ToPlot (AreaSpots z) where-    toPlot p = Plot { plot_render_ = renderAreaSpots p-                    , plot_legend_ = [(area_spots_title_ p, renderSpotLegend p)]-                    , plot_all_points_ = ( map fst3 (area_spots_values_ p)-                                         , map snd3 (area_spots_values_ p) )-                    }--renderAreaSpots  :: (PlotValue z) =>-                    AreaSpots z x y -> PointMapFn x y -> CRender ()-renderAreaSpots p pmap = preserveCState $-    forM_ (scaleMax ((area_spots_max_radius_ p)^2)-                    (area_spots_values_ p))-          (\ (x,y,z)-> do-              let radius = sqrt z-              let (CairoPointStyle drawSpotAt)    = filledCircles radius-                                                      (area_spots_fillcolour_ p)-              drawSpotAt (pmap (LValue x, LValue y))-              let (CairoPointStyle drawOutlineAt) = hollowCircles radius-                                                      (area_spots_linethick_ p)-                                                      (area_spots_linecolour_ p)-              drawOutlineAt (pmap (LValue x, LValue y))-          )-  where-    scaleMax :: PlotValue z => Double -> [(x,y,z)] -> [(x,y,Double)]-    scaleMax n points = let largest  = maximum (map (toValue . thd3) points)-                            scale v  = n * toValue v / largest-                        in map (\ (x,y,z) -> (x,y, scale z)) points--renderSpotLegend :: AreaSpots z x y -> Rect -> CRender ()-renderSpotLegend p r@(Rect p1 p2) = preserveCState $ do-    let radius = min (abs (p_y p1 - p_y p2)) (abs (p_x p1 - p_x p2))-        centre = linearInterpolate p1 p2-    let (CairoPointStyle drawSpotAt)    = filledCircles radius-                                            (area_spots_fillcolour_ p)-    drawSpotAt centre-    let (CairoPointStyle drawOutlineAt) = hollowCircles radius-                                            (area_spots_linethick_ p)-                                            (area_spots_linecolour_ p)-    drawOutlineAt centre-  where-    linearInterpolate (Point x0 y0) (Point x1 y1) =-        Point (x0 + abs(x1-x0)/2) (y0 + abs(y1-y0)/2)------------------------------------------------------------------------------ Template haskell to derive Data.Accessor.Accessor-$( deriveAccessors ''AreaSpots )

@@ -6,769 +6,22 @@ -- -- Code to calculate and render axes. ----- Note that template haskell is used to derive accessor functions--- (see 'Data.Accessor') for each field of the following data types:------     * 'AxisData'------     * 'AxisStyle'------     * 'LinearAxisParams'------     * 'LogAxisParams'------ These accessors are not shown in this API documentation.  They have--- the same name as the field, but with the trailing underscore--- dropped. Hence for data field f_::F in type D, they have type------ @---   f :: Data.Accessor.Accessor D F--- @---  {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-}  module Graphics.Rendering.Chart.Axis(-    AxisData(..),-    AxisT(..),-    LinearAxisParams(..),-    LogAxisParams(..),-    AxisStyle(..),-    PlotValue(..),-    LogValue(..),-    PlotIndex(..),-    AxisFn,--    defaultAxisLineStyle,-    defaultLinearAxis,-    defaultIntAxis,-    defaultLogAxis,-    defaultAxisStyle,-    autoScaledAxis,-    autoScaledLogAxis,-    unitAxis,-    timeAxis,-    autoTimeAxis,-    days, months, years,-    autoIndexAxis,-    addIndexes,--    autoSteps,--    axisToRenderable,-    renderAxisGrid,-    axisOverhang,-    vmap,--    axisGridAtTicks,-    axisGridAtLabels,-    axisGridHide,-    axisTicksHide,-    axisLabelsHide,--    axis_viewport,-    axis_ticks,-    axis_labels,-    axis_grid,--    axis_line_style,-    axis_label_style,-    axis_grid_style,-    axis_label_gap,--    la_labelf,-    la_nLabels,-    la_nTicks,--    loga_labelf,-+    module Graphics.Rendering.Chart.Axis.Types,+    module Graphics.Rendering.Chart.Axis.Floating,+    module Graphics.Rendering.Chart.Axis.Int,+    module Graphics.Rendering.Chart.Axis.LocalTime,+    module Graphics.Rendering.Chart.Axis.Unit,+    module Graphics.Rendering.Chart.Axis.Indexed, ) where -import qualified Graphics.Rendering.Cairo as C-import Data.Time-import Data.Fixed-import System.Locale (defaultTimeLocale)-import Control.Monad-import Data.List-import Data.Accessor.Template-import Data.Colour (opaque)-import Data.Colour.Names (black, lightgrey)-import Data.Ord (comparing)--import Graphics.Rendering.Chart.Types-import Graphics.Rendering.Chart.Renderable---- | The basic data associated with an axis showing values of type x.-data AxisData x = AxisData {--    -- | The axis_viewport_ function maps values into device coordinates.-    axis_viewport_ :: Range -> x -> Double,--    -- | The tick marks on the axis as pairs.-    --   The first element is the position on the axis-    --   (in viewport units) and the second element is the-    --   length of the tick in output coordinates.-    --   The tick starts on the axis, and positive numbers are drawn-    --   towards the plot area.-    axis_ticks_    :: [(x,Double)],--    -- | The labels on an axis as pairs. The first element-    --   is the position on the axis (in viewport units) and-    --   the second is the label text string.-    axis_labels_   :: [ (x, String) ],--    -- | The positions on the axis (in viewport units) where-    --   we want to show grid lines.-    axis_grid_     :: [ x ]-}---- | Control values for how an axis gets displayed.-data AxisStyle = AxisStyle {-    axis_line_style_  :: CairoLineStyle,-    axis_label_style_ :: CairoFontStyle,-    axis_grid_style_  :: CairoLineStyle,--    -- | How far the labels are to be drawn from the axis.-    axis_label_gap_   :: Double-}---- | A function to generate the axis data, given the data values---   to be plotted against it.-type AxisFn x = [x] -> AxisData x---- | Collect the information we need to render an axis. The---   bool is true if the axis direction is reversed.-data AxisT x = AxisT RectEdge AxisStyle Bool (AxisData x)--instance ToRenderable (AxisT x) where-  toRenderable = setPickFn nullPickFn.axisToRenderable--axisToRenderable :: AxisT x -> Renderable x-axisToRenderable at = Renderable {-     minsize = minsizeAxis at,-     render  = renderAxis at-  }--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) }--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)-    labelSizes <- preserveCState $ do-        setFontStyle (axis_label_style_ as)-        mapM textSize labels-    let (lw,lh) = foldl maxsz (0,0) labelSizes-    let ag      = axis_label_gap_ as-    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)-		     E_Left   -> (max (addIfNZ lw ag) tsize, lh)-		     E_Right  -> (max (addIfNZ lw ag) tsize, lh)-    return sz--  where-    maxsz (w1,h1) (w2,h2)   = (max w1 w2, max h1 h2)-    addIfNZ a b | a == 0    = 0-                | otherwise = a+b----- | Calculate the amount by which the labels extend beyond---   the ends of the axis.-axisOverhang :: Ord x => AxisT x -> CRender (Double,Double)-axisOverhang (AxisT at as rev ad) = do-    let labels = map snd (sort (axis_labels_ ad))-    labelSizes <- preserveCState $ do-        setFontStyle (axis_label_style_ as)-        mapM textSize labels-    case labelSizes of-        []  -> return (0,0)-	ls  -> let l1     = head ls-		   l2     = last ls-		   ohangv = return (snd l1 / 2, snd l2 / 2)-		   ohangh = return (fst l1 / 2, fst l2 / 2)-		   in-		   case at of-		       E_Top    -> ohangh-		       E_Bottom -> ohangh-		       E_Left   -> ohangv-		       E_Right  -> ohangh--renderAxis :: AxisT x -> RectSize -> CRender (PickFn x)-renderAxis at@(AxisT et as rev ad) sz = do-   let ls = axis_line_style_ as-   preserveCState $ do-       setLineStyle ls{line_cap_=C.LineCapSquare}-       strokePath [Point sx sy,Point ex ey]-   preserveCState $ do-       setLineStyle ls{line_cap_=C.LineCapButt}-       mapM_ drawTick (axis_ticks_ ad)-   preserveCState $ do-       setFontStyle (axis_label_style_ as)-       mapM_ drawLabel (axis_labels_ ad)-   return nullPickFn- where-   (sx,sy,ex,ey,tp,axisPoint) = axisMapping at sz--   drawTick (value,length) =-       let t1 = axisPoint value-	   t2 = t1 `pvadd` (vscale length tp)-       in strokePath [t1,t2]--   (hta,vta,lp) =-       let g = axis_label_gap_ as-       in case et of-              E_Top    -> (HTA_Centre, VTA_Bottom, (Vector 0 (-g)))-              E_Bottom -> (HTA_Centre, VTA_Top,    (Vector 0 g))-              E_Left   -> (HTA_Right,  VTA_Centre, (Vector (-g) 0))-              E_Right  -> (HTA_Left,   VTA_Centre, (Vector g 0))--   drawLabel (value,s) = do-       drawText hta vta (axisPoint value `pvadd` lp) s--axisMapping :: AxisT z -> RectSize-               -> (Double,Double,Double,Double,Vector,z->Point)-axisMapping (AxisT et as rev ad) (x2,y2) = case et of-    E_Top    -> (x1,y2,x2,y2, (Vector 0 1),    mapx (x1,x2) y2)-    E_Bottom -> (x1,y1,x2,y1, (Vector 0 (-1)), mapx (x1,x2) y1)-    E_Left   -> (x2,y2,x2,y1, (Vector (1) 0),  mapy (y1,y2) x2)		-    E_Right  -> (x1,y2,x1,y1, (Vector (-1) 0), mapy (y1,y2) x1)-  where-    (x1,y1) = (0,0)--    mapx xr y x        = Point (axis_viewport_ ad (reverse xr) x) y-    mapy (yr0,yr1) x y = Point x (axis_viewport_ ad (reverse (yr1,yr0)) y)-    reverse r@(r0,r1)  = if rev then (r1,r0) else r--renderAxisGrid :: RectSize -> AxisT z -> CRender ()-renderAxisGrid sz@(w,h) at@(AxisT re as rev ad) = do-    preserveCState $ do-        setLineStyle (axis_grid_style_ as)-        mapM_ (drawGridLine re) (axis_grid_ ad)-  where-    (sx,sy,ex,ey,tp,axisPoint) = axisMapping at sz--    drawGridLine E_Top    = vline-    drawGridLine E_Bottom = vline-    drawGridLine E_Left   = hline-    drawGridLine E_Right  = hline--    vline v = let v' = p_x (axisPoint v)-	      in strokePath [Point v' 0,Point v' h]--    hline v = let v' = p_y (axisPoint v)-	      in strokePath [Point 0 v',Point w v']---stepsInt :: Integral a => a -> Range -> [a]-stepsInt nSteps range = bestSize (goodness alt0) alt0 alts-  where-    bestSize n a (a':as) = let n' = goodness a' in-                           if n' < n then bestSize n' a' as else a--    goodness vs          = abs (genericLength vs - nSteps)--    (alt0:alts)          = map (\n -> steps n range) sampleSteps--    sampleSteps          = [1,2,5] ++ sampleSteps1-    sampleSteps1         = [10,20,25,50] ++ map (*10) sampleSteps1--    steps size (min,max) = takeWhile (<b) [a,a+size..] ++ [b]-      where-        a = (floor   (min / fromIntegral size)) * size-        b = (ceiling (max / fromIntegral size)) * size--steps :: RealFloat a => a -> (a,a) -> [Rational]-steps nSteps (min,max) = map ((s*) . fromIntegral) [min' .. max']-  where-    s    = chooseStep nSteps (min,max)-    min' = floor   $ realToFrac min / s-    max' = ceiling $ realToFrac max / s-    n    = (max' - min')---chooseStep :: RealFloat a => a -> (a,a) -> Rational-chooseStep nsteps (x1,x2) = minimumBy (comparing proximity) steps-  where-    delta = x2 - x1-    mult  = 10 ^^ (floor $ log10 $ delta / nsteps)-    steps = map (mult*) [0.1,0.2,0.25,0.5,1.0,2.0,2.5,5.0,10,20,25,50]-    proximity x = abs $ delta / realToFrac x - nsteps---- | Given a target number of values, and a list of input points,---   find evenly spaced values from the set {1*X, 2*X, 2.5*X, 5*X} (where---   X is some power of ten) that evenly cover the input points.-autoSteps :: Int -> [Double] -> [Double]-autoSteps nSteps vs = map fromRational $ steps (fromIntegral nSteps) r-  where-    range []  = (0,1)-    range _   | min == max = (min-0.5,min+0.5)-              | otherwise  = (min,max)-    (min,max) = (minimum ps,maximum ps)-    ps        = filter isValidNumber vs-    r         = range ps--makeAxis :: PlotValue x => (x -> String) -> ([x],[x],[x]) -> AxisData x-makeAxis labelf (labelvs, tickvs, gridvs) = AxisData {-    axis_viewport_ = newViewport,-    axis_ticks_    = newTicks,-    axis_grid_     = gridvs,-    axis_labels_   = newLabels-    }-  where-    newViewport = vmap (min',max')-    newTicks    = [ (v,2)        | v <- tickvs  ] ++ [ (v,5) | v <- labelvs ]-    newLabels   = [ (v,labelf v) | v <- labelvs ]-    min'        = minimum labelvs-    max'        = maximum labelvs--makeAxis' :: Ord x => (x -> Double) -> (x -> String) -> ([x],[x],[x]) -> AxisData x-makeAxis' f labelf (labelvs, tickvs, gridvs) = AxisData {-    axis_viewport_ = linMap f (minimum labelvs, maximum labelvs),-    axis_ticks_    = zip tickvs (repeat 2)  ++  zip labelvs (repeat 5),-    axis_grid_     = gridvs,-    axis_labels_   = [ (v,labelf v) | v <- labelvs ]-    }--data LinearAxisParams a = LinearAxisParams {-    -- | The function used to show the axes labels.-    la_labelf_  :: a -> String,--    -- | The target number of labels to be shown.-    la_nLabels_ :: Int,--    -- | The target number of ticks to be shown.-    la_nTicks_  :: Int-}---defaultLinearAxis :: (Show a) => LinearAxisParams a-defaultLinearAxis = LinearAxisParams {-    la_labelf_    = showD,-    la_nLabels_   = 5,-    la_nTicks_    = 50-}--defaultIntAxis :: (Show a) => LinearAxisParams a-defaultIntAxis  = LinearAxisParams {-    la_labelf_  = show,-    la_nLabels_ = 5,-    la_nTicks_  = 10-}---- | Generate a linear axis automatically.---   The supplied axis is used as a template, with the viewport, ticks, labels---   and grid set appropriately for the data displayed against that axies.---   The resulting axis will only show a grid if the template has some grid---   values.-autoScaledAxis :: RealFloat a => LinearAxisParams a -> AxisFn a-autoScaledAxis lap ps0 = makeAxis' realToFrac (la_labelf_ lap) (labelvs,tickvs,gridvs)-  where-    ps        = filter isValidNumber ps0-    (min,max) = (minimum ps,maximum ps)-    range []  = (0,1)-    range _   | min == max = (min-1,min+1)-              | otherwise  = (min,max)-    labelvs   = map fromRational $ steps (fromIntegral (la_nLabels_ lap)) r-    tickvs    = map fromRational $ steps (fromIntegral (la_nTicks_ lap))-                                         (minimum labelvs,maximum labelvs)-    gridvs    = labelvs-    r         = range ps--showD x = case reverse $ show x of-            '0':'.':r -> reverse r-            _         -> show x---autoScaledIntAxis :: (Integral i, PlotValue i) =>-                     LinearAxisParams i -> AxisFn i-autoScaledIntAxis lap ps =-    makeAxis (la_labelf_ lap) (labelvs,tickvs,gridvs)-  where-    (min,max) = (minimum ps,maximum ps)-    range []  = (0,1)-    range _   | min == max = (fromIntegral $ min-1, fromIntegral $ min+1)-              | otherwise  = (fromIntegral $ min,   fromIntegral $ max)---  labelvs  :: [i]-    labelvs   = stepsInt (fromIntegral $ la_nLabels_ lap) r-    tickvs    = stepsInt (fromIntegral $ la_nTicks_ lap)-                                  ( fromIntegral $ minimum labelvs-                                  , fromIntegral $ maximum labelvs )-    gridvs    = labelvs-    r         = range ps---log10 :: (Floating a) => a -> a-log10 = logBase 10--frac x | 0 <= b    = (a,b)-       | otherwise = (a-1,b+1)- where-  (a,b) = properFraction x--{-- Rules: Do not subdivide between powers of 10 until all powers of 10-          get a major ticks.-        Do not subdivide between powers of ten as [1,2,4,6,8,10] when-          5 gets a major ticks-          (ie the major ticks need to be a subset of the minor tick)--}-logTicks :: Range -> ([Rational],[Rational],[Rational])-logTicks (low,high) = (major,minor,major)- where-  ratio      = high/low-  lower a l  = let (i,r) = frac (log10 a) in-               (maximum (1:filter (\x -> log10 (fromRational x) <= r) l))*10^^i-  upper a l  = let (i,r) = properFraction (log10 a) in-               (minimum (10:filter (\x -> r <= log10 (fromRational x)) l))*10^^i-  powers           :: (Double,Double) -> [Rational] -> [Rational]-  powers (x,y) l    = [ a*10^^p | p <- [(floor (log10 x))..(ceiling (log10 y))]-                                , a <- l ]-  midselection r l  = filter (inRange r l) (powers r l)-  inRange (a,b) l x = (lower a l <= x) && (x <= upper b l)-  major | 17.5 < log10 ratio = map (\x -> 10^^(round x)) $-                               steps (min 5 (log10 ratio))-                                                       (log10 low, log10 high)-        | 12 < log10 ratio   = map (\x -> 10^^(round x)) $-                               steps ((log10 ratio)/5) (log10 low, log10 high)-        | 6 < log10 ratio    = map (\x -> 10^^(round x)) $-                               steps ((log10 ratio)/2) (log10 low, log10 high)-        | 3 < log10 ratio    = midselection (low,high) [1,10]-        | 20 < ratio         = midselection (low,high) [1,5,10]-        | 6 < ratio          = midselection (low,high) [1,2,4,6,8,10]-        | 3 < ratio          = midselection (low,high) [1..10]-        | otherwise          = steps 5 (low,high)-  (l',h')   = (minimum major, maximum major)-  (dl',dh') = (fromRational l', fromRational h')-  ratio'    = fromRational (h'/l')-  minor | 50 < log10 ratio' = map (\x -> 10^^(round x)) $-                              steps 50 (log10 $ dl', log10 $ dh')-        | 6 < log10 ratio'  = filter (\x -> l'<=x && x <=h') $-                              powers (dl', dh') [1,10]-        | 3 < log10 ratio'  = filter (\x -> l'<=x && x <=h') $-                              powers (dl',dh') [1,5,10]-        | 6 < ratio'        = filter (\x -> l'<=x && x <=h') $-                              powers (dl',dh') [1..10]-        | 3 < ratio'        = filter (\x -> l'<=x && x <=h') $-                              powers (dl',dh') [1,1.2..10]-        | otherwise         = steps 50 (dl', dh')---- | Generate a log axis automatically.---   The supplied axis is used as a template, with the viewport, ticks, labels---   and grid set appropriately for the data displayed against that axis.---   The resulting axis will only show a grid if the template has some grid---   values.-autoScaledLogAxis :: RealFloat a => LogAxisParams a -> AxisFn a-autoScaledLogAxis lap ps0 =-    makeAxis' (realToFrac . log) (loga_labelf_ lap) (wrap rlabelvs, wrap rtickvs, wrap rgridvs)-        where-          ps        = filter (\x -> isValidNumber x && 0 < x) ps0-          (min,max) = (minimum ps,maximum ps)-          wrap      = map fromRational-          range []  = (3,30)-          range _   | min == max = (realToFrac $ min/3, realToFrac $ max*3)-                    | otherwise  = (realToFrac $ min,   realToFrac $ max)-          (rlabelvs, rtickvs, rgridvs) = logTicks (range ps)---data LogAxisParams a = LogAxisParams {-    -- | The function used to show the axes labels.-    loga_labelf_ :: a -> String-}--defaultLogAxis :: Show a => LogAxisParams a-defaultLogAxis = LogAxisParams {-    loga_labelf_ = showD-}--------------------------------------------------------------------------defaultAxisLineStyle :: CairoLineStyle-defaultAxisLineStyle = solidLine 1 $ opaque black--defaultGridLineStyle :: CairoLineStyle-defaultGridLineStyle = dashedLine 1 [5,5] $ opaque lightgrey--defaultAxisStyle :: AxisStyle-defaultAxisStyle = AxisStyle {-    axis_line_style_  = defaultAxisLineStyle,-    axis_label_style_ = defaultFontStyle,-    axis_grid_style_  = defaultGridLineStyle,-    axis_label_gap_   = 10-}---------------------------------------------------------------------------- | Map a LocalTime value to a plot coordinate.-doubleFromLocalTime :: LocalTime -> Double-doubleFromLocalTime lt = fromIntegral (toModifiedJulianDay (localDay lt))-              + fromRational (timeOfDayToDayFraction (localTimeOfDay lt))---- | Map a plot coordinate to a LocalTime.-localTimeFromDouble :: Double -> LocalTime-localTimeFromDouble v =-  LocalTime (ModifiedJulianDay i) (dayFractionToTimeOfDay (toRational d))- where-   (i,d) = properFraction v---- | TimeSeq is a (potentially infinite) set of times. When passed---   a reference time, the function returns a a pair of lists. The first---   contains all times in the set less than the reference time in---   decreasing order. The second contains all times in the set greater---   than or equal to the reference time, in increasing order.-type TimeSeq = LocalTime-> ([LocalTime],[LocalTime])--coverTS tseq min max = min' ++ enumerateTS tseq min max ++ max'-  where-    min' =  if elemTS min tseq then [] else take 1 (fst (tseq min))-    max' =  if elemTS max tseq then [] else take 1 (snd (tseq max))--enumerateTS tseq min max =-    reverse (takeWhile (>=min) ts1)  ++ takeWhile (<=max) ts2-  where-    (ts1,ts2) = tseq min--elemTS t tseq = case tseq t of-    (_,(t0:_)) | t == t0 -> True-    _                    -> False---- | How to display a time-type TimeLabelFn = LocalTime -> String---- | Create an 'AxisFn' to for a time axis.  The first 'TimeSeq' sets the---   minor ticks, and the ultimate range will be aligned to its elements.---   The second 'TimeSeq' sets the labels and grid.  The 'TimeLabelFn' is---   used to format LocalTimes for labels.  The values to be plotted---   against this axis can be created with 'doubleFromLocalTime'.-timeAxis :: TimeSeq -> TimeSeq -> TimeLabelFn -> AxisFn LocalTime-timeAxis tseq lseq labelf pts = AxisData {-    axis_viewport_ = vmap(min', max'),-    axis_ticks_    = [ (t,2) | t <- times] ++ [ (t,5) | t <- ltimes, visible t],-    axis_labels_   = [ (t,l) | (t,l) <- labels, visible t],-    axis_grid_     = [ t     | t <- ltimes, visible t]-    }-  where-    (min,max)    = case pts of-                       [] -> (refLocalTime,refLocalTime)-                       ps -> (minimum ps, maximum ps)-    refLocalTime = LocalTime (ModifiedJulianDay 0) midnight-    times        = coverTS tseq min max-    ltimes       = coverTS lseq min max-    min'         = minimum times-    max'         = maximum times-    visible t    = min' <= t && t <= max'-    labels       = [ (avg m1 m2, labelf m1)-                   | (m1,m2) <- zip ltimes (tail ltimes) ]-    avg m1 m2    = localTimeFromDouble $ m1' + (m2' - m1')/2-     where-      m1' = doubleFromLocalTime m1-      m2' = doubleFromLocalTime m2--normalizeTimeOfDay :: LocalTime -> LocalTime-normalizeTimeOfDay t@(LocalTime day (TimeOfDay h m s))-  | s >= 60   = normalizeTimeOfDay (LocalTime day (TimeOfDay h (m+s`div'`60)-                                                               (s`mod'`60)))-  | m >= 60   = normalizeTimeOfDay (LocalTime day (TimeOfDay (h+m`div`60)-                                                             (m`mod`60) s))-  | h >= 24   = LocalTime (addDays (fromIntegral (h`div`24)) day)-                          (TimeOfDay (h`mod`24) m s)-  | otherwise = t--addTod :: Int -> Int -> Int -> LocalTime -> LocalTime-addTod dh dm ds (LocalTime day (TimeOfDay h m s)) = normalizeTimeOfDay t'-  where t' = LocalTime day (TimeOfDay (h+dh) (m+dm) (s+fromIntegral ds))----- | A 'TimeSeq' for seconds.-seconds :: TimeSeq-seconds t = (iterate rev t1, tail (iterate fwd t1))-  where h0       = todHour (localTimeOfDay t)-        m0       = todMin  (localTimeOfDay t)-        s0       = todSec  (localTimeOfDay t)-        t0       = LocalTime (localDay t) (TimeOfDay h0 m0 s0)-        t1       = if t0 < t then t0 else (rev t0)-        rev      = addTod 0 0 (-1)-        fwd      = addTod 0 0 1-        toTime h = LocalTime---- | A 'TimeSeq' for minutes.-minutes :: TimeSeq-minutes t = (iterate rev t1, tail (iterate fwd t1))-  where h0       = todHour (localTimeOfDay t)-        m0       = todMin  (localTimeOfDay t)-        t0       = LocalTime (localDay t) (TimeOfDay h0 m0 0)-        t1       = if t0 < t then t0 else (rev t0)-        rev      = addTod 0 (-1)0-        fwd      = addTod 0 1   0-        toTime h = LocalTime---- | A 'TimeSeq' for hours.-hours :: TimeSeq-hours t = (iterate rev t1, tail (iterate fwd t1))-  where h0       = todHour (localTimeOfDay t)-        t0       = LocalTime (localDay t) (TimeOfDay h0 0 0)-        t1       = if t0 < t then t0 else (rev t0)-        rev      = addTod (-1) 0 0-        fwd      = addTod 1    0 0-        toTime h = LocalTime---- | A 'TimeSeq' for calendar days.-days :: TimeSeq-days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))-  where t0       = localDay t-        t1       = if (toTime t0) < t then t0 else (rev t0)-        rev      = pred-        fwd      = succ-        toTime d = LocalTime d midnight---- | A 'TimeSeq' for calendar months.-months :: TimeSeq-months t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))-  where t0       = let (y,m,d) = toGregorian $ localDay t in fromGregorian y m 1-        t1       = if toTime t0 < t then t0 else (rev t0)-        rev      = addGregorianMonthsClip (-1)-        fwd      = addGregorianMonthsClip 1-        toTime d = LocalTime d midnight---- | A 'TimeSeq' for calendar years.-years :: TimeSeq-years t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))-  where t0       = let (y,m,d) = toGregorian $ localDay t in y-        t1       = if toTime t0 < t then t0 else (rev t0)-        rev      = pred-        fwd      = succ-        toTime y = LocalTime (fromGregorian y 1 1) midnight---- | Automatically choose a suitable time axis, based upon the time range---   of data.  The values to be plotted against this axis can be created---   with 'doubleFromLocalTime'.-autoTimeAxis :: AxisFn LocalTime-autoTimeAxis [] = timeAxis days days (formatTime defaultTimeLocale "%d-%b")  []-autoTimeAxis pts-    | tdiff==0 && dsec<60   = timeAxis seconds seconds (ft "%H:%M:%S") pts-    | tdiff==0 && dsec<3600 = timeAxis minutes minutes (ft "%H:%M") pts-    | tdiff < 1             = timeAxis hours  hours (ft "%H:%M")     pts-    | tdiff < 2             = timeAxis days   hours   (ft "%d-%b") pts-    | tdiff < 15            = timeAxis days   days    (ft "%d-%b")     pts-    | tdiff < 90            = timeAxis days   months  (ft "%b-%y")     pts-    | tdiff < 450           = timeAxis months months  (ft "%b-%y")     pts-    | tdiff < 1800          = timeAxis months years   (ft "%Y")        pts-    | otherwise             = timeAxis years  years   (ft "%Y")        pts-  where-    tdiff = diffDays (localDay t1) (localDay t0)-    dsec  = fromIntegral (3600*(h1-h0)+60*(m1-m0))+(s1-s0)-      where (TimeOfDay h0 m0 s0) = localTimeOfDay t0-            (TimeOfDay h1 m1 s1) = localTimeOfDay t1-    t1    = maximum pts-    t0    = minimum pts-    ft    = formatTime defaultTimeLocale---unitAxis :: AxisData ()-unitAxis = AxisData {-    axis_viewport_ = \(x0,x1) _ -> (x0+x1)/2,-    axis_ticks_    = [((), 0)],-    axis_labels_   = [((), "")],-    axis_grid_     = []-}---------------------------------------------------------------------------------class Ord a => PlotValue a where-    toValue  :: a -> Double-    autoAxis :: AxisFn a--instance PlotValue Double where-    toValue  = id-    autoAxis = autoScaledAxis defaultLinearAxis--newtype LogValue = LogValue Double-                    deriving (Eq, Ord, Num, Real, Fractional, RealFrac, Floating, RealFloat)--instance Show LogValue where-    show (LogValue x) = show x--instance PlotValue LogValue where-    toValue (LogValue x) = log x-    autoAxis             = autoScaledLogAxis defaultLogAxis--instance PlotValue Int where-    toValue    = fromIntegral-    autoAxis   = autoScaledIntAxis defaultIntAxis--instance PlotValue Integer where-    toValue    = fromIntegral-    autoAxis   = autoScaledIntAxis defaultIntAxis--instance PlotValue () where-    toValue () = 0-    autoAxis   = const unitAxis--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,Enum,Num,Real,Integral,Show)--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 :: Integral i => [String] -> [i] -> AxisData i-autoIndexAxis labels vs = AxisData {-    axis_viewport_ = vport,-    axis_ticks_    = [],-    axis_labels_   = filter (\(i,l) -> i >= imin && i <= imax)-                            (zip [0..] labels),-    axis_grid_     = []-    }-  where-    vport r i = linMap id ( fromIntegral imin - 0.5-                          , fromIntegral imax + 0.5) r (fromIntegral i)-    imin = minimum vs-    imax = maximum vs---- | 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-vmap (v1,v2) (v3,v4) v = v3 + (toValue v - toValue v1) * (v4-v3)-                              / (toValue v2 - toValue v1)---- | A linear mapping of points in one range to another.-linMap :: (a -> Double) -> (a,a) -> Range -> a -> Double-linMap f (x1,x2) (d1,d2) x =-    d1 + (d2 - d1) * (f x - f x1) / (f x2 - f x1)--------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor for--- each field.-$( deriveAccessors ''AxisData )-$( deriveAccessors ''AxisStyle )-$( deriveAccessors ''LinearAxisParams )-$( deriveAccessors ''LogAxisParams )-+import Graphics.Rendering.Chart.Axis.Types+import Graphics.Rendering.Chart.Axis.Floating+import Graphics.Rendering.Chart.Axis.Int+import Graphics.Rendering.Chart.Axis.LocalTime+import Graphics.Rendering.Chart.Axis.Unit+import Graphics.Rendering.Chart.Axis.Indexed

@@ -0,0 +1,224 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Axis.Floating+-- Copyright   :  (c) Tim Docker 2010+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Calculate and render floating value axes+-- including doubles with linear, log, and percentage scaling.+--++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Axis.Floating(+    Percent(..),+    LinearAxisParams(..),+    LogValue(..),+    LogAxisParams(..),+    defaultLinearAxis,+    defaultLogAxis,+    autoScaledAxis,+    autoScaledLogAxis,+    autoSteps,++    la_labelf,+    la_nLabels,+    la_nTicks,++    loga_labelf+) where++import Data.List(minimumBy)+import Data.Ord (comparing)++import Data.Accessor.Template+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Axis.Types++instance PlotValue Double where+    toValue  = id+    fromValue= id+    autoAxis = autoScaledAxis defaultLinearAxis++-- | A wrapper class for doubles used to indicate they are to+-- be plotted against a percentage axis.+newtype Percent = Percent {unPercent :: Double}+    deriving (Eq,Ord,Num,Real,Fractional,RealFrac,Floating,RealFloat)++instance Show Percent where+    show (Percent d) = showD (d*100) ++ "%"++instance PlotValue Percent where+    toValue  = unPercent+    fromValue= Percent+    autoAxis = autoScaledAxis defaultLinearAxis{-la_labelf_=-}++-- | A wrapper class for doubles used to indicate they are to+-- be plotted against a log axis.+newtype LogValue = LogValue Double+    deriving (Eq, Ord, Num, Real, Fractional, RealFrac, Floating, RealFloat)++instance Show LogValue where+    show (LogValue x) = show x++instance PlotValue LogValue where+    toValue (LogValue x) = log x+    fromValue d          = LogValue (exp d)+    autoAxis             = autoScaledLogAxis defaultLogAxis++showD x = case reverse $ show x of+            '0':'.':r -> reverse r+            _         -> show x++data LinearAxisParams a = LinearAxisParams {+    -- | The function used to show the axes labels.+    la_labelf_  :: a -> String,++    -- | The target number of labels to be shown.+    la_nLabels_ :: Int,++    -- | The target number of ticks to be shown.+    la_nTicks_  :: Int+}++defaultLinearAxis :: (Show a) => LinearAxisParams a+defaultLinearAxis = LinearAxisParams {+    la_labelf_    = showD,+    la_nLabels_   = 5,+    la_nTicks_    = 50+}++-- | Generate a linear axis automatically, scaled appropriately for the+-- input data.+autoScaledAxis :: RealFloat a => LinearAxisParams a -> AxisFn a+autoScaledAxis lap ps0 = makeAxis' realToFrac realToFrac+                                   (la_labelf_ lap) (labelvs,tickvs,gridvs)+  where+    ps        = filter isValidNumber ps0+    (min,max) = (minimum ps,maximum ps)+    range []  = (0,1)+    range _   | min == max = (min-1,min+1)+              | otherwise  = (min,max)+    labelvs   = map fromRational $ steps (fromIntegral (la_nLabels_ lap)) r+    tickvs    = map fromRational $ steps (fromIntegral (la_nTicks_ lap))+                                         (minimum labelvs,maximum labelvs)+    gridvs    = labelvs+    r         = range ps++steps :: RealFloat a => a -> (a,a) -> [Rational]+steps nSteps (min,max) = map ((s*) . fromIntegral) [min' .. max']+  where+    s    = chooseStep nSteps (min,max)+    min' = floor   $ realToFrac min / s+    max' = ceiling $ realToFrac max / s+    n    = (max' - min')+++chooseStep :: RealFloat a => a -> (a,a) -> Rational+chooseStep nsteps (x1,x2) = minimumBy (comparing proximity) steps+  where+    delta = x2 - x1+    mult  = 10 ^^ (floor $ log10 $ delta / nsteps)+    steps = map (mult*) [0.1,0.2,0.25,0.5,1.0,2.0,2.5,5.0,10,20,25,50]+    proximity x = abs $ delta / realToFrac x - nsteps++-- | Given a target number of values, and a list of input points,+--   find evenly spaced values from the set {1*X, 2*X, 2.5*X, 5*X} (where+--   X is some power of ten) that evenly cover the input points.+autoSteps :: Int -> [Double] -> [Double]+autoSteps nSteps vs = map fromRational $ steps (fromIntegral nSteps) r+  where+    range []  = (0,1)+    range _   | min == max = (min-0.5,min+0.5)+              | otherwise  = (min,max)+    (min,max) = (minimum ps,maximum ps)+    ps        = filter isValidNumber vs+    r         = range ps++----------------------------------------------------------------------++defaultLogAxis :: Show a => LogAxisParams a+defaultLogAxis = LogAxisParams {+    loga_labelf_ = showD+}++-- | Generate a log axis automatically, scaled appropriate for the+-- input data.+autoScaledLogAxis :: RealFloat a => LogAxisParams a -> AxisFn a+autoScaledLogAxis lap ps0 =+    makeAxis' (realToFrac . log) (realToFrac . exp)+              (loga_labelf_ lap) (wrap rlabelvs, wrap rtickvs, wrap rgridvs)+        where+          ps        = filter (\x -> isValidNumber x && 0 < x) ps0+          (min,max) = (minimum ps,maximum ps)+          wrap      = map fromRational+          range []  = (3,30)+          range _   | min == max = (realToFrac $ min/3, realToFrac $ max*3)+                    | otherwise  = (realToFrac $ min,   realToFrac $ max)+          (rlabelvs, rtickvs, rgridvs) = logTicks (range ps)+++data LogAxisParams a = LogAxisParams {+    -- | The function used to show the axes labels.+    loga_labelf_ :: a -> String+}++{-+ Rules: Do not subdivide between powers of 10 until all powers of 10+          get a major ticks.+        Do not subdivide between powers of ten as [1,2,4,6,8,10] when+          5 gets a major ticks+          (ie the major ticks need to be a subset of the minor tick)+-}+logTicks :: Range -> ([Rational],[Rational],[Rational])+logTicks (low,high) = (major,minor,major)+ where+  ratio      = high/low+  lower a l  = let (i,r) = frac (log10 a) in+               (maximum (1:filter (\x -> log10 (fromRational x) <= r) l))*10^^i+  upper a l  = let (i,r) = properFraction (log10 a) in+               (minimum (10:filter (\x -> r <= log10 (fromRational x)) l))*10^^i+  powers           :: (Double,Double) -> [Rational] -> [Rational]+  powers (x,y) l    = [ a*10^^p | p <- [(floor (log10 x))..(ceiling (log10 y))]+                                , a <- l ]+  midselection r l  = filter (inRange r l) (powers r l)+  inRange (a,b) l x = (lower a l <= x) && (x <= upper b l)+  major | 17.5 < log10 ratio = map (\x -> 10^^(round x)) $+                               steps (min 5 (log10 ratio))+                                                       (log10 low, log10 high)+        | 12 < log10 ratio   = map (\x -> 10^^(round x)) $+                               steps ((log10 ratio)/5) (log10 low, log10 high)+        | 6 < log10 ratio    = map (\x -> 10^^(round x)) $+                               steps ((log10 ratio)/2) (log10 low, log10 high)+        | 3 < log10 ratio    = midselection (low,high) [1,10]+        | 20 < ratio         = midselection (low,high) [1,5,10]+        | 6 < ratio          = midselection (low,high) [1,2,4,6,8,10]+        | 3 < ratio          = midselection (low,high) [1..10]+        | otherwise          = steps 5 (low,high)+  (l',h')   = (minimum major, maximum major)+  (dl',dh') = (fromRational l', fromRational h')+  ratio'    = fromRational (h'/l')+  minor | 50 < log10 ratio' = map (\x -> 10^^(round x)) $+                              steps 50 (log10 $ dl', log10 $ dh')+        | 6 < log10 ratio'  = filter (\x -> l'<=x && x <=h') $+                              powers (dl', dh') [1,10]+        | 3 < log10 ratio'  = filter (\x -> l'<=x && x <=h') $+                              powers (dl',dh') [1,5,10]+        | 6 < ratio'        = filter (\x -> l'<=x && x <=h') $+                              powers (dl',dh') [1..10]+        | 3 < ratio'        = filter (\x -> l'<=x && x <=h') $+                              powers (dl',dh') [1,1.2..10]+        | otherwise         = steps 50 (dl', dh')++log10 :: (Floating a) => a -> a+log10 = logBase 10++frac x | 0 <= b    = (a,b)+       | otherwise = (a-1,b+1)+ where+  (a,b) = properFraction x++$( deriveAccessors ''LinearAxisParams )+$( deriveAccessors ''LogAxisParams )+

@@ -0,0 +1,50 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Axis.Unit+-- Copyright   :  (c) Tim Docker 2010+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Calculate and render indexed axes++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Axis.Indexed(+    PlotIndex(..),+    autoIndexAxis,+    addIndexes,+) where++import Graphics.Rendering.Chart.Axis.Types++-- | 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,Enum,Num,Real,Integral,Show)++instance PlotValue PlotIndex where+    toValue (PlotIndex i) = fromIntegral i+    fromValue             = PlotIndex . round+    autoAxis              = autoIndexAxis []++-- | 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)++-- | Create an axis for values indexed by position. The+--   list of strings are the labels to be used.+autoIndexAxis :: Integral i => [String] -> [i] -> AxisData i+autoIndexAxis labels vs = AxisData {+    axis_viewport_ = vport,+    axis_tropweiv_ = invport,+    axis_ticks_    = [],+    axis_labels_   = [filter (\(i,l) -> i >= imin && i <= imax)+                            (zip [0..] labels)],+    axis_grid_     = []+    }+  where+    vport r i = linMap id ( fromIntegral imin - 0.5+                          , fromIntegral imax + 0.5) r (fromIntegral i)+    invport r z = invLinMap round fromIntegral (imin, imax) r z+    imin = minimum vs+    imax = maximum vs

@@ -0,0 +1,73 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Axis.Int+-- Copyright   :  (c) Tim Docker 2010+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Calculate and render integer indexed axes++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Axis.Int(+    defaultIntAxis,+    autoScaledIntAxis+) where++import Data.List(genericLength)+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Axis.Types+import Graphics.Rendering.Chart.Axis.Floating++instance PlotValue Int where+    toValue    = fromIntegral+    fromValue  = round+    autoAxis   = autoScaledIntAxis defaultIntAxis++instance PlotValue Integer where+    toValue    = fromIntegral+    fromValue  = round+    autoAxis   = autoScaledIntAxis defaultIntAxis++defaultIntAxis :: (Show a) => LinearAxisParams a+defaultIntAxis  = LinearAxisParams {+    la_labelf_  = show,+    la_nLabels_ = 5,+    la_nTicks_  = 10+}++autoScaledIntAxis :: (Integral i, PlotValue i) =>+                     LinearAxisParams i -> AxisFn i+autoScaledIntAxis lap ps =+    makeAxis (la_labelf_ lap) (labelvs,tickvs,gridvs)+  where+    (min,max) = (minimum ps,maximum ps)+    range []  = (0,1)+    range _   | min == max = (fromIntegral $ min-1, fromIntegral $ min+1)+              | otherwise  = (fromIntegral $ min,   fromIntegral $ max)+--  labelvs  :: [i]+    labelvs   = stepsInt (fromIntegral $ la_nLabels_ lap) r+    tickvs    = stepsInt (fromIntegral $ la_nTicks_ lap)+                                  ( fromIntegral $ minimum labelvs+                                  , fromIntegral $ maximum labelvs )+    gridvs    = labelvs+    r         = range ps++stepsInt :: Integral a => a -> Range -> [a]+stepsInt nSteps range = bestSize (goodness alt0) alt0 alts+  where+    bestSize n a (a':as) = let n' = goodness a' in+                           if n' < n then bestSize n' a' as else a++    goodness vs          = abs (genericLength vs - nSteps)++    (alt0:alts)          = map (\n -> steps n range) sampleSteps++    sampleSteps          = [1,2,5] ++ sampleSteps1+    sampleSteps1         = [10,20,25,50] ++ map (*10) sampleSteps1++    steps size (min,max) = takeWhile (<b) [a,a+size..] ++ [b]+      where+        a = (floor   (min / fromIntegral size)) * size+        b = (ceiling (max / fromIntegral size)) * size+

@@ -0,0 +1,273 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Axis.LocalTime+-- Copyright   :  (c) Tim Docker 2010+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Calculate and render time axes++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Axis.LocalTime(+    timeAxis,+    autoTimeAxis,+    days, months, years+) where++import qualified Graphics.Rendering.Cairo as C+import Data.Time+import Data.Fixed+import System.Locale (defaultTimeLocale)+import Control.Monad+import Data.List+import Data.Accessor.Template+import Data.Colour (opaque)+import Data.Colour.Names (black, lightgrey)+import Data.Ord (comparing)++import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Axis.Types++instance PlotValue LocalTime where+    toValue    = doubleFromLocalTime+    fromValue  = localTimeFromDouble+    autoAxis   = autoTimeAxis++----------------------------------------------------------------------++-- | Map a LocalTime value to a plot coordinate.+doubleFromLocalTime :: LocalTime -> Double+doubleFromLocalTime lt = fromIntegral (toModifiedJulianDay (localDay lt))+              + fromRational (timeOfDayToDayFraction (localTimeOfDay lt))++-- | Map a plot coordinate to a LocalTime.+localTimeFromDouble :: Double -> LocalTime+localTimeFromDouble v =+  LocalTime (ModifiedJulianDay i) (dayFractionToTimeOfDay (toRational d))+ where+   (i,d) = properFraction v++-- | TimeSeq is a (potentially infinite) set of times. When passed+--   a reference time, the function returns a a pair of lists. The first+--   contains all times in the set less than the reference time in+--   decreasing order. The second contains all times in the set greater+--   than or equal to the reference time, in increasing order.+type TimeSeq = LocalTime-> ([LocalTime],[LocalTime])++coverTS :: TimeSeq -> LocalTime -> LocalTime -> [LocalTime]+coverTS tseq min max = min' ++ enumerateTS tseq min max ++ max'+  where+    min' =  if elemTS min tseq then [] else take 1 (fst (tseq min))+    max' =  if elemTS max tseq then [] else take 1 (snd (tseq max))++enumerateTS :: TimeSeq -> LocalTime -> LocalTime -> [LocalTime]+enumerateTS tseq min max =+    reverse (takeWhile (>=min) ts1)  ++ takeWhile (<=max) ts2+  where+    (ts1,ts2) = tseq min++elemTS :: LocalTime -> TimeSeq -> Bool+elemTS t tseq = case tseq t of+    (_,(t0:_)) | t == t0 -> True+    _                    -> False++-- | How to display a time+type TimeLabelFn = LocalTime -> String++data TimeLabelAlignment = UnderTicks+                        | BetweenTicks+                        deriving (Show)++-- | Create an 'AxisFn' to for a time axis.  The first 'TimeSeq' sets the+--   minor ticks, and the ultimate range will be aligned to its elements.+--   The second 'TimeSeq' sets the labels and grid.  The third 'TimeSeq'+--   sets the second line of labels.  The 'TimeLabelFn' is+--   used to format LocalTimes for labels.  The values to be plotted+--   against this axis can be created with 'doubleFromLocalTime'.+timeAxis :: TimeSeq -> TimeSeq -> TimeLabelFn -> TimeLabelAlignment -> +                       TimeSeq -> TimeLabelFn -> TimeLabelAlignment -> +            AxisFn LocalTime+timeAxis tseq lseq labelf lal cseq contextf clal pts = AxisData {+    axis_viewport_ = vmap(min', max'),+    axis_tropweiv_ = invmap(min', max'),+    axis_ticks_    = [ (t,2) | t <- times] ++ [ (t,5) | t <- ltimes, visible t],+    axis_labels_   = [ [ (t,l) | (t,l) <- labels labelf   ltimes lal, visible t]+                     , [ (t,l) | (t,l) <- labels contextf ctimes clal, visible t]+                     ], +    axis_grid_     = [ t     | t <- ltimes, visible t]+    }+  where+    (min,max)    = case pts of+                       [] -> (refLocalTime,refLocalTime)+                       ps -> (minimum ps, maximum ps)+    refLocalTime = LocalTime (ModifiedJulianDay 0) midnight+    times        = coverTS tseq min max+    ltimes       = coverTS lseq min max+    ctimes       = coverTS cseq min max+    min'         = minimum times+    max'         = maximum times+    visible t    = min' <= t && t <= max'+    labels f ts lal =+        [ (align lal m1' m2', f m1)+          | (m1,m2) <- zip ts (tail ts)+          , let m1' = if m1<min' then min' else m1+          , let m2' = if m2>max' then max' else m2 ]++    align BetweenTicks m1 m2 = avg m1 m2+    align UnderTicks m1 m2 = m1++    avg m1 m2    = localTimeFromDouble $ m1' + (m2' - m1')/2+     where+      m1' = doubleFromLocalTime m1+      m2' = doubleFromLocalTime m2++normalizeTimeOfDay :: LocalTime -> LocalTime+normalizeTimeOfDay t@(LocalTime day (TimeOfDay h m s))+  | s <  0    = normalizeTimeOfDay (LocalTime day (TimeOfDay h (m-1) (s+60)))+  | m <  0    = normalizeTimeOfDay (LocalTime day (TimeOfDay (h-1) (m+60) s))+  | h <  0    = normalizeTimeOfDay (LocalTime (addDays (-1) day) (TimeOfDay (h+24) m s))+  | s >= 60   = normalizeTimeOfDay (LocalTime day (TimeOfDay h (m+s`div'`60)+                                                               (s`mod'`60)))+  | m >= 60   = normalizeTimeOfDay (LocalTime day (TimeOfDay (h+m`div`60)+                                                             (m`mod`60) s))+  | h >= 24   = LocalTime (addDays (fromIntegral (h`div`24)) day)+                          (TimeOfDay (h`mod`24) m s)+  | otherwise = t++addTod :: Int -> Int -> Pico -> LocalTime -> LocalTime+addTod dh dm ds (LocalTime day (TimeOfDay h m s)) = normalizeTimeOfDay t'+  where t' = LocalTime day (TimeOfDay (h+dh) (m+dm) (s+ds))++truncateTo :: (HasResolution a) => Fixed a -> Fixed a -> Fixed a+truncateTo t step = t - t `mod'` step++secondSeq :: Pico -> TimeSeq+secondSeq step t = (iterate rev t1, tail (iterate fwd t1))+  where h0       = todHour (localTimeOfDay t)+        m0       = todMin  (localTimeOfDay t)+        s0       = todSec  (localTimeOfDay t) `truncateTo` (fromIntegral 1 / 1000)+        t0       = LocalTime (localDay t) (TimeOfDay h0 m0 s0)+        t1       = if t0 < t then t0 else (rev t0)+        rev      = addTod 0 0 (negate step)+        fwd      = addTod 0 0 (step)++millis1, millis10, millis100, seconds, fiveSeconds  :: TimeSeq+millis1 = secondSeq (fromIntegral 1 / 1000)+millis10 = secondSeq (fromIntegral 1 / 100)+millis100 = secondSeq (fromIntegral 1 / 10)+seconds = secondSeq (fromIntegral 1)+fiveSeconds = secondSeq (fromIntegral 5)++minuteSeq :: Int -> TimeSeq+minuteSeq step t = (iterate rev t1, tail (iterate fwd t1))+  where h0       = todHour (localTimeOfDay t)+        m0       = todMin  (localTimeOfDay t)+        t0       = LocalTime (localDay t) (TimeOfDay h0 m0 0)+        t1       = if t0 < t then t0 else (rev t0)+        rev      = addTod 0 (negate step) (fromIntegral 0)+        fwd      = addTod 0 step    (fromIntegral 0)+++minutes, fiveMinutes :: TimeSeq+minutes = minuteSeq 1+fiveMinutes = minuteSeq 5++-- | A 'TimeSeq' for hours.+hours :: TimeSeq+hours t = (iterate rev t1, tail (iterate fwd t1))+  where h0       = todHour (localTimeOfDay t)+        t0       = LocalTime (localDay t) (TimeOfDay h0 0 0)+        t1       = if t0 < t then t0 else (rev t0)+        rev      = addTod (-1) 0 (fromIntegral 0)+        fwd      = addTod 1    0 (fromIntegral 0)++-- | A 'TimeSeq' for calendar days.+days :: TimeSeq+days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))+  where t0       = localDay t+        t1       = if (toTime t0) < t then t0 else (rev t0)+        rev      = pred+        fwd      = succ+        toTime d = LocalTime d midnight++-- | A 'TimeSeq' for calendar months.+months :: TimeSeq+months t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))+  where t0       = let (y,m,d) = toGregorian $ localDay t in fromGregorian y m 1+        t1       = if toTime t0 < t then t0 else (rev t0)+        rev      = addGregorianMonthsClip (-1)+        fwd      = addGregorianMonthsClip 1+        toTime d = LocalTime d midnight++-- | A 'TimeSeq' for calendar years.+years :: TimeSeq+years t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))+  where t0       = let (y,m,d) = toGregorian $ localDay t in y+        t1       = if toTime t0 < t then t0 else (rev t0)+        rev      = pred+        fwd      = succ+        toTime y = LocalTime (fromGregorian y 1 1) midnight++-- | A 'TimeSeq' for no sequence at all.+noTime :: TimeSeq+noTime t = ([],[])++-- | Automatically choose a suitable time axis, based upon the time range+--   of data.  The values to be plotted against this axis can be created+--   with 'doubleFromLocalTime'.+autoTimeAxis :: AxisFn LocalTime+autoTimeAxis pts+    | null pts              = timeAxis days    days    (ft "%d-%b-%y") UnderTicks+                                               noTime  (ft "") UnderTicks []+    | tdiff==0 && 100*dsec<1= timeAxis millis1   millis1  (ft "%S%Q") UnderTicks +                                                 noTime (ft "%S%Q") UnderTicks pts+    | tdiff==0 && 10*dsec<1 = timeAxis millis10  millis10  (ft "%S%Q") UnderTicks +                                                 noTime (ft "%S%Q") UnderTicks pts+    | tdiff==0 && dsec<1    = timeAxis millis10  millis100 (ft "%S%Q") UnderTicks+                                                 seconds (ft "%M:%S") BetweenTicks pts+    | tdiff==0 && dsec<5    = timeAxis millis100 seconds (ft "%M:%S%Q") UnderTicks+                                                 seconds (ft "%M:%S") BetweenTicks pts+    | tdiff==0 && dsec<32   = timeAxis seconds seconds (ft "%Ss") UnderTicks+                                               minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts+    | tdiff==0 && dsec<120  = timeAxis seconds fiveSeconds (ft "%Ss") UnderTicks+                                               minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts+    | tdiff==0 && dmin<7    = timeAxis fiveSeconds minutes (ft "%Mm") UnderTicks+                                               hours   (ft "%d-%b-%y %H:00") BetweenTicks pts+    | tdiff==0 && dmin<32   = timeAxis minutes minutes (ft "%Mm") UnderTicks+                                               hours   (ft "%d-%b-%y %H:00") BetweenTicks pts+    | tdiff==0 && dmin<90   = timeAxis minutes fiveMinutes (ft "%Mm") UnderTicks+                                               hours   (ft "%d-%b-%y %H:00") BetweenTicks pts+    | tdiff < 2 && dhour<4  = timeAxis fiveMinutes hours (ft "%H:%M") UnderTicks+                                                   days  (ft "%d-%b-%y") BetweenTicks pts+    | tdiff < 2 && dhour<32 = timeAxis hours  hours  (ft "%H:%M") UnderTicks+                                              days   (ft "%d-%b-%y") BetweenTicks pts+    | tdiff < 4             = timeAxis hours  days   (ft "%d-%b-%y") BetweenTicks+                                              noTime (ft "") BetweenTicks pts+    | tdiff < 12            = timeAxis days   days   (ft "%d-%b") BetweenTicks+                                              years  (ft "%Y") BetweenTicks pts+    | tdiff < 45            = timeAxis days   days   (ft "%d") BetweenTicks+                                              months (ft "%b-%y") BetweenTicks pts+    | tdiff < 95            = timeAxis days   months (ft "%b-%y") BetweenTicks+                                              noTime (ft "") BetweenTicks pts+    | tdiff < 450           = timeAxis months months (ft "%b-%y") BetweenTicks+                                              noTime (ft "") BetweenTicks pts+    | tdiff < 735           = timeAxis months months (ft "%b") BetweenTicks+                                              years  (ft "%Y") BetweenTicks pts+    | tdiff < 1800          = timeAxis months years (ft "%Y") BetweenTicks+                                              noTime (ft "") BetweenTicks pts+    | otherwise             = timeAxis years  years (ft "%Y") BetweenTicks+                                              noTime (ft "") BetweenTicks pts+  where+    tdiff = diffDays (localDay t1) (localDay t0)+    dhour = if tdiff==0 then h1-h0 else 24*fromIntegral tdiff +h1-h0+    dmin  = 60*dhour+(m1-m0)+    dsec  = fromIntegral (60*dmin) + (s1-s0)+    (TimeOfDay h0 m0 s0) = localTimeOfDay t0+    (TimeOfDay h1 m1 s1) = localTimeOfDay t1+    t1    = maximum pts+    t0    = minimum pts+    ft    = formatTime defaultTimeLocale++

@@ -0,0 +1,405 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Axis.Types+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Type definitions for Axes+--++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Axis.Types(+    AxisData(..),+    AxisT(..),+    AxisStyle(..),+    PlotValue(..),+    AxisFn,++    defaultAxisLineStyle,+    defaultAxisStyle,+    defaultGridLineStyle,++    makeAxis,+    makeAxis',++    axisToRenderable,+    renderAxisGrid,+    axisOverhang,+    vmap,+    invmap,++    linMap,+    invLinMap,++    axisGridAtTicks,+    axisGridAtLabels,+    axisGridHide,+    axisTicksHide,+    axisLabelsHide,++    axis_viewport,+    axis_tropweiv,+    axis_ticks,+    axis_labels,+    axis_grid,++    axis_line_style,+    axis_label_style,+    axis_grid_style,+    axis_label_gap,++) where++import qualified Graphics.Rendering.Cairo as C+import Data.Time+import Data.Fixed+import System.Locale (defaultTimeLocale)+import Control.Monad+import Data.List(sort,intersperse)+import Data.Accessor.Template+import Data.Colour (opaque)+import Data.Colour.Names (black, lightgrey)++import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable++-- | A typeclass abstracting the functions we need+-- to be able to plot against an axis of type a+class Ord a => PlotValue a where+    toValue  :: a -> Double+    fromValue:: Double -> a+    autoAxis :: AxisFn a++-- | The basic data associated with an axis showing values of type x.+data AxisData x = AxisData {++    -- | The axis_viewport_ function maps values into device coordinates.+    axis_viewport_ :: Range -> x -> Double,++    -- | The axis_tropweiv_ function maps device coordinates back to values.+    axis_tropweiv_ :: Range -> Double -> x,++    -- | The tick marks on the axis as pairs.+    --   The first element is the position on the axis+    --   (in viewport units) and the second element is the+    --   length of the tick in output coordinates.+    --   The tick starts on the axis, and positive numbers are drawn+    --   towards the plot area.+    axis_ticks_    :: [(x,Double)],++    -- | The labels on an axis as pairs. The first element of the pair+    --   is the position on the axis (in viewport units) and the+    --   second is the label text string. Note that multiple sets of+    --   labels can be specified, and are shown successively further+    --   away from the axis line.+    axis_labels_   :: [[(x, String)]],++    -- | The positions on the axis (in viewport units) where+    --   we want to show grid lines.+    axis_grid_     :: [ x ]+}++-- | Control values for how an axis gets displayed.+data AxisStyle = AxisStyle {+    axis_line_style_  :: CairoLineStyle,+    axis_label_style_ :: CairoFontStyle,+    axis_grid_style_  :: CairoLineStyle,++    -- | How far the labels are to be drawn from the axis.+    axis_label_gap_   :: Double+}++-- | A function to generate the axis data, given the data values+--   to be plotted against it.+type AxisFn x = [x] -> AxisData x++-- | Collect the information we need to render an axis. The+--   bool is true if the axis direction is reversed.+data AxisT x = AxisT RectEdge AxisStyle Bool (AxisData x)++-- | Construct a renderable from an axis, in order that+-- it can be composed with other renderables and drawn. This+-- does not include the drawing of the grid, which must be done+-- separately by the `renderAxisGrid` function.+axisToRenderable :: AxisT x -> Renderable x+axisToRenderable at = Renderable {+     minsize = minsizeAxis at,+     render  = renderAxis at+  }++-- | Modifier to remove grid lines from an axis+axisGridHide        :: AxisData x -> AxisData x+axisGridHide ad      = ad{ axis_grid_   = [] }++-- | Modifier to position grid lines to line up with the ticks+axisGridAtTicks     :: AxisData x -> AxisData x+axisGridAtTicks ad   = ad{ axis_grid_   = map fst (axis_ticks_ ad) }++-- | Modifier to position grid lines to line up with the labels+axisGridAtLabels    :: AxisData x -> AxisData x+axisGridAtLabels ad  = ad{ axis_grid_   = map fst vs }+  where+    vs = case axis_labels_ ad of+        [] -> []+        ls -> head ls++-- | Modifier to remove ticks from an axis+axisTicksHide       :: AxisData x -> AxisData x+axisTicksHide ad     = ad{ axis_ticks_  = [] }++-- | Modifier to remove labels from an axis+axisLabelsHide      :: AxisData x -> AxisData x+axisLabelsHide ad    = ad{ axis_labels_ = []}++minsizeAxis :: AxisT x -> CRender RectSize+minsizeAxis (AxisT at as rev ad) = do+    labelSizes <- preserveCState $ do+        setFontStyle (axis_label_style_ as)+        mapM (mapM textSize) (labelTexts ad)++    let ag      = axis_label_gap_ as+    let tsize   = maximum ([0] ++ [ max 0 (-l) | (v,l) <- axis_ticks_ ad ])++    let hw = maximum0 (map (maximum0.map fst) labelSizes)+    let hh = ag + tsize + (sum . intersperse ag . map (maximum0.map snd) $ labelSizes)++    let vw = ag + tsize + (sum . intersperse ag . map (maximum0.map fst) $ labelSizes)+    let vh = maximum0 (map (maximum0.map snd) labelSizes)++    let sz      = case at of+		     E_Top    -> (hw,hh)+		     E_Bottom -> (hw,hh)+		     E_Left   -> (vw,vh)+		     E_Right  -> (vw,vh)+    return sz++labelTexts :: AxisData a -> [[String]]+labelTexts ad = map (map snd) (axis_labels_ ad)++maximum0 [] = 0+maximum0 vs = maximum vs++-- | Calculate the amount by which the labels extend beyond+--   the ends of the axis.+axisOverhang :: Ord x => AxisT x -> CRender (Double,Double)+axisOverhang (AxisT at as rev ad) = do+    let labels = map snd . sort . concat . axis_labels_ $ ad+    labelSizes <- preserveCState $ do+        setFontStyle (axis_label_style_ as)+        mapM textSize labels+    case labelSizes of+        []  -> return (0,0)+	ls  -> let l1     = head ls+		   l2     = last ls+		   ohangv = return (snd l1 / 2, snd l2 / 2)+		   ohangh = return (fst l1 / 2, fst l2 / 2)+		   in+		   case at of+		       E_Top    -> ohangh+		       E_Bottom -> ohangh+		       E_Left   -> ohangv+		       E_Right  -> ohangh++renderAxis :: AxisT x -> RectSize -> CRender (PickFn x)+renderAxis at@(AxisT et as rev ad) sz = do+   let ls = axis_line_style_ as+   preserveCState $ do+       setLineStyle ls{line_cap_=C.LineCapSquare}+       strokePath [Point sx sy,Point ex ey]+   preserveCState $ do+       setLineStyle ls{line_cap_=C.LineCapButt}+       mapM_ drawTick (axis_ticks_ ad)+   preserveCState $ do+       setFontStyle (axis_label_style_ as)+       labelSizes <- mapM (mapM textSize) (labelTexts ad)+       let sizes = map ((+ag).maximum0.map coord) labelSizes+       let offsets = scanl (+) ag sizes+       mapM_ drawLabels (zip offsets  (axis_labels_ ad))++   return pickfn+ where+   (sx,sy,ex,ey,tp,axisPoint,invAxisPoint) = axisMapping at sz++   drawTick (value,length) =+       let t1 = axisPoint value+	   t2 = t1 `pvadd` (vscale length tp)+       in strokePath [t1,t2]++   (hta,vta,coord,awayFromAxis) = case et of+       E_Top    -> (HTA_Centre, VTA_Bottom, snd, \v -> (Vector 0 (-v)))+       E_Bottom -> (HTA_Centre, VTA_Top,    snd, \v -> (Vector 0 v))+       E_Left   -> (HTA_Right,  VTA_Centre, fst, \v -> (Vector (-v) 0))+       E_Right  -> (HTA_Left,   VTA_Centre, fst, \v -> (Vector v 0))++   avoidOverlaps labels = do+       rects <- mapM labelDrawRect labels+       return $ map snd . head . filter (noOverlaps . map fst) $ map (\n -> eachNth n rects) [0 .. length rects]++   labelDrawRect (value,s) = do+       let pt = axisPoint value `pvadd` (awayFromAxis ag)+       r <- textDrawRect hta vta pt s+       return (hBufferRect r,(value,s))++   drawLabels (offset,labels) = do+        labels' <- avoidOverlaps labels+        mapM_ drawLabel labels'+     where+       drawLabel (value,s) = do+           drawText hta vta (axisPoint value `pvadd` (awayFromAxis offset)) s+           textSize s++   ag = axis_label_gap_ as+   pickfn = Just . invAxisPoint++hBufferRect :: Rect -> Rect+hBufferRect (Rect p (Point x y)) = Rect p $ Point x' y+  where x' = x + w/2+        w = x - (p_x p)++noOverlaps :: [Rect] -> Bool+noOverlaps [] = True+noOverlaps [_] = True+noOverlaps (x:y:l) | rectsOverlap x y = False+                   | otherwise        = noOverlaps (y:l)++rectsOverlap :: Rect -> Rect -> Bool+rectsOverlap (Rect p1 p2) r = any (withinRect r) ps+  where (Point x1 y1) = p1+        (Point x2 y2) = p2+        p3 = Point x1 y2+        p4 = Point x2 y1+        ps = [p1,p2,p3,p4]++eachNth n = skipN+  where+    n' = n - 1+    skipN [] = []+    skipN (x:xs) = x : skipN (drop n' xs)++withinRect :: Rect -> Point -> Bool+withinRect (Rect (Point x1 y1) (Point x2 y2)) (Point x y)+    = and [x >= x1 && x <= x2,+           y >= y1 && y <= y2]++axisMapping :: AxisT z -> RectSize+               -> (Double,Double,Double,Double,Vector,z->Point,Point->z)+axisMapping (AxisT et as rev ad) (x2,y2) = case et of+    E_Top    -> (x1,y2,x2,y2, (Vector 0 1),    mapx y2, imapx)+    E_Bottom -> (x1,y1,x2,y1, (Vector 0 (-1)), mapx y1, imapx)+    E_Left   -> (x2,y2,x2,y1, (Vector (1) 0),  mapy x2, imapy) +    E_Right  -> (x1,y2,x1,y1, (Vector (-1) 0), mapy x1, imapy)+  where+    (x1,y1) = (0,0)+    xr = reverse (x1,x2)+    yr = reverse (y2,y1)++    mapx y x = Point (axis_viewport_ ad xr x) y+    mapy x y = Point x (axis_viewport_ ad yr y)++    imapx (Point x _) = axis_tropweiv_ ad xr x+    imapy (Point _ y) = axis_tropweiv_ ad yr y++    reverse r@(r0,r1)  = if rev then (r1,r0) else r++-- +renderAxisGrid :: RectSize -> AxisT z -> CRender ()+renderAxisGrid sz@(w,h) at@(AxisT re as rev ad) = do+    preserveCState $ do+        setLineStyle (axis_grid_style_ as)+        mapM_ (drawGridLine re) (axis_grid_ ad)+  where+    (sx,sy,ex,ey,tp,axisPoint,invAxisPoint) = axisMapping at sz++    drawGridLine E_Top    = vline+    drawGridLine E_Bottom = vline+    drawGridLine E_Left   = hline+    drawGridLine E_Right  = hline++    vline v = let v' = p_x (axisPoint v)+	      in strokePath [Point v' 0,Point v' h]++    hline v = let v' = p_y (axisPoint v)+	      in strokePath [Point 0 v',Point w v']+++-- | Construct an axis given the positions for ticks, grid lines, and +-- labels, and the labelling function+makeAxis :: PlotValue x => (x -> String) -> ([x],[x],[x]) -> AxisData x+makeAxis labelf (labelvs, tickvs, gridvs) = AxisData {+    axis_viewport_ = newViewport,+    axis_tropweiv_ = newTropweiv,+    axis_ticks_    = newTicks,+    axis_grid_     = gridvs,+    axis_labels_   = [newLabels]+    }+  where+    newViewport = vmap (min',max')+    newTropweiv = invmap (min',max')+    newTicks    = [ (v,2)        | v <- tickvs  ] ++ [ (v,5) | v <- labelvs ]+    newLabels   = [ (v,labelf v) | v <- labelvs ]+    min'        = minimum labelvs+    max'        = maximum labelvs++-- | Construct an axis given the positions for ticks, grid lines, and +-- labels, and the positioning and labelling functions+makeAxis' :: Ord x => (x -> Double) -> (Double -> x) -> (x -> String)+                   -> ([x],[x],[x]) -> AxisData x+makeAxis' t f labelf (labelvs, tickvs, gridvs) = AxisData {+    axis_viewport_ = linMap t (minimum labelvs, maximum labelvs),+    axis_tropweiv_ = invLinMap f t (minimum labelvs, maximum labelvs),+    axis_ticks_    = zip tickvs (repeat 2)  ++  zip labelvs (repeat 5),+    axis_grid_     = gridvs,+    axis_labels_   = [[ (v,labelf v) | v <- labelvs ]]+    }+++----------------------------------------------------------------------++defaultAxisLineStyle :: CairoLineStyle+defaultAxisLineStyle = solidLine 1 $ opaque black++defaultGridLineStyle :: CairoLineStyle+defaultGridLineStyle = dashedLine 1 [5,5] $ opaque lightgrey++defaultAxisStyle :: AxisStyle+defaultAxisStyle = AxisStyle {+    axis_line_style_  = defaultAxisLineStyle,+    axis_label_style_ = defaultFontStyle,+    axis_grid_style_  = defaultGridLineStyle,+    axis_label_gap_   = 10+}++----------------------------------------------------------------------++-- | A linear mapping of points in one range to another.+vmap :: PlotValue x => (x,x) -> Range -> x -> Double+vmap (v1,v2) (v3,v4) v = v3 + (toValue v - toValue v1) * (v4-v3)+                              / (toValue v2 - toValue v1)++-- | The inverse mapping from device co-ordinate range back to+--   interesting values.+invmap :: PlotValue x => (x,x) -> Range -> Double -> x+invmap (v3,v4) (d1,d2) d = fromValue (toValue v3 + ( (d-d1) * doubleRange+                                                   / (d2-d1) ))+    where doubleRange = toValue v4 - toValue v3++-- | A linear mapping of points in one range to another.+linMap :: (a -> Double) -> (a,a) -> Range -> a -> Double+linMap f (x1,x2) (d1,d2) x =+    d1 + (d2 - d1) * (f x - f x1) / (f x2 - f x1)++-- | An inverse linear mapping of points from one range to another.+invLinMap :: (Double -> a) -> (a -> Double) -> (a,a) -> Range -> Double -> a+invLinMap f t (v3,v4) (d1,d2) d =+    f (t v3 + ( (d-d1) * doubleRange / (d2-d1) ))+  where+    doubleRange = t v4 - t v3++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor for+-- each field.+$( deriveAccessors ''AxisData )+$( deriveAccessors ''AxisStyle )+

@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Axis.Unit+-- Copyright   :  (c) Tim Docker 2010+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Calculate and render unit indexed axes++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Axis.Unit(+    unitAxis,+) where++import Graphics.Rendering.Chart.Axis.Types++instance PlotValue () where+    toValue () = 0+    fromValue  = const ()+    autoAxis   = const unitAxis++unitAxis :: AxisData ()+unitAxis = AxisData {+    axis_viewport_ = \(x0,x1) _ -> (x0+x1)/2,+    axis_tropweiv_ = \_       _ -> (),+    axis_ticks_    = [((), 0)],+    axis_labels_   = [[((), "")]],+    axis_grid_     = []+}

@@ -1,3 +1,12 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Grid+-- Copyright   :  (c) Tim Docker 2010+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- A container type for values that can be composed by horizonal+-- and vertical layout.+ module Graphics.Rendering.Chart.Grid (     Grid, Span,     tval, tspan,@@ -266,7 +275,8 @@             p1'@(Point x1 y1) <- alignc p1             preserveCState $ do                 c $ C.translate x0 y0-                render r (x1-x0,y1-y0)+                pf <- render r (x1-x0,y1-y0)+                return (newpf pf x0 y0)         (Above t1 t2 _) -> do              pf1 <- rf1 borders (i,j) t1              pf2 <- rf1 borders (i,j+height t1) t2@@ -284,6 +294,8 @@              pf1 <- rf1 borders (i,j) t1              let pf p = pf1 p `mplus` pf2 p              return pf++    newpf pf x0 y0 = \ (Point x1 y1)-> pf (Point (x1-x0) (y1-y0))      -- (x borders, y borders) -> (x,y) -> (w,h)     --     -> rectangle of grid[x..x+w, y..y+h]

@@ -5,7 +5,9 @@ -- License     :  BSD-style (see chart/COPYRIGHT)  module Graphics.Rendering.Chart.Gtk(-    renderableToWindow+    renderableToWindow,+    createRenderableWindow,+    updateCanvas     ) where  import qualified Graphics.UI.Gtk as G

@@ -28,9 +28,11 @@ module Graphics.Rendering.Chart.Layout(     Layout1(..),     LayoutAxis(..),+    Layout1Pick(..),     MAxisFn,      defaultLayout1,+    layout1ToRenderable,     linkAxes,     independentAxes, @@ -137,11 +139,14 @@ }  data Layout1Pick x y = L1P_Legend String+                     | L1P_Title String+                     | L1P_AxisTitle String                      | L1P_PlotArea x y y                      | L1P_BottomAxis x                      | L1P_TopAxis x                      | L1P_LeftAxis y                      | L1P_RightAxis y+    deriving (Show)  instance (Ord x, Ord y) => ToRenderable (Layout1 x y) where     toRenderable = setPickFn nullPickFn.layout1ToRenderable@@ -213,8 +218,11 @@   where     lm = layout1_margin_ l -layout1TitleToRenderable :: (Ord x, Ord y) => Layout1 x y -> Renderable a-layout1TitleToRenderable l = addMargins (lm/2,0,0,0) title+layout1TitleToRenderable :: (Ord x, Ord y) => Layout1 x y+                                           -> Renderable (Layout1Pick x y)+layout1TitleToRenderable l | null (layout1_title_ l) = emptyRenderable+layout1TitleToRenderable l = addMargins (lm/2,0,0,0)+                                        (mapPickFn L1P_Title title)   where     title = label (layout1_title_style_ l) HTA_Centre VTA_Centre                   (layout1_title_ l)@@ -266,7 +274,8 @@     er = tval $ emptyRenderable      atitle ha va rot af = if ttext == "" then er-                          else tval $ rlabel tstyle ha va rot ttext+                          else tval $ mapPickFn L1P_AxisTitle+                                    $ rlabel tstyle ha va rot ttext       where         tstyle = laxis_title_style_ (af l)         ttext  = laxis_title_       (af l)@@ -305,7 +314,7 @@         setClipRegion (Point 0 0) (Point w h)         mapM_ rPlot (layout1_plots_ l)     when (layout1_grid_last_ l) renderGrids-    return nullPickFn+    return pickfn    where     (bAxis,lAxis,tAxis,rAxis) = getAxes l@@ -313,16 +322,34 @@     rPlot (Left  p) = rPlot1 bAxis lAxis p     rPlot (Right p) = rPlot1 bAxis rAxis p +    xr = (0, w)+    yr = (h, 0)+    reverse rev (a,b) = if rev then (b,a) else (a,b)+     rPlot1 (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p =-      let xrange = if xrev then (w, 0) else (0, w)+      let +          xr1 = reverse xrev xr+          yr1 = reverse yrev yr           yrange = if yrev then (0, h) else (h, 0)-          pmfn (x,y) = Point (mapv xrange (axis_viewport_ xaxis xrange) x)-                             (mapv yrange (axis_viewport_ yaxis yrange) y)+          pmfn (x,y) = Point (mapv xr1 (axis_viewport_ xaxis xr1) x)+                             (mapv yr1 (axis_viewport_ yaxis yr1) y)           mapv (min,max) _ LMin       = min           mapv (min,max) _ LMax       = max           mapv _         f (LValue v) = f v 	  in plot_render_ p pmfn     rPlot1 _ _ _ = return ()++    pickfn (Point x y) = Just (L1P_PlotArea xv yv1 yv2)+      where+        xv = case (bAxis,tAxis) of+            (Just at,_) -> mapx at x+            (_,Just at) -> mapx at x+        (yv1,yv2) = case (lAxis,rAxis) of+            (Just at,Nothing) -> (mapy at y,mapy at y)+            (Nothing,Just at) -> (mapy at y,mapy at y)+            (Just at1,Just at2) -> (mapy at1 y,mapy at2 y)+        mapx (AxisT _ _ rev ad) x = axis_tropweiv_ ad (reverse rev xr) x+        mapy (AxisT _ _ rev ad) y = axis_tropweiv_ ad (reverse rev yr) y      renderGrids = do       maybeM () (renderAxisGrid sz) tAxis

@@ -3,6 +3,9 @@ -- Module      :  Graphics.Rendering.Chart.Legend -- Copyright   :  (c) Tim Docker 2006 -- License     :  BSD-style (see chart/COPYRIGHT)+-- +-- Types and functions for handling the legend(s) on a chart. A legend+-- is an area on the chart used to label the plotted values.  {-# OPTIONS_GHC -XTemplateHaskell #-} @@ -24,7 +27,7 @@ import Data.Accessor.Template  import Graphics.Rendering.Chart.Types-import Graphics.Rendering.Chart.Plot+import Graphics.Rendering.Chart.Plot.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Grid @@ -73,7 +76,7 @@                      minsize = return (legend_plot_size_ ls, 0),                      render  = \(w,h) -> do                           rfn (Rect (Point 0 0) (Point w h))-                         return nullPickFn+                         return (\_-> Just title)                  }      ggap1 = tval $ spacer (legend_margin_ ls,legend_margin_ ls / 2)

@@ -1,228 +0,0 @@-{-# OPTIONS_GHC -XTemplateHaskell #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Graphics.Rendering.Chart.Layout
--- Copyright   :  (c) Tim Docker 2008
--- License     :  BSD-style (see chart/COPYRIGHT)
---
--- A  basic pie chart.
---
--- Note that template haskell is used to derive accessor functions
--- (see 'Data.Accessor') for each field of the following data types:
---
---     * 'PieLayout'
---
---     * 'PieChart'
---
---     * 'PieItem'
---
--- These accessors are not shown in this API documentation.  They have
--- the same name as the field, but with the trailing underscore
--- dropped. Hence for data field f_::F in type D, they have type
---
--- @
---   f :: Data.Accessor.Accessor D F
--- @
---
-
-
-module Graphics.Rendering.Chart.Pie(
-    PieLayout(..),
-    PieChart(..),
-    PieItem(..),
-    defaultPieLayout,
-    defaultPieChart,
-    defaultPieItem,
-
-    pie_title,
-    pie_title_style,
-    pie_plot,
-    pie_background,
-    pie_margin,
-    pie_data,
-    pie_colors,
-    pie_label_style,
-    pie_label_line_style,
-    pie_start_angle,
-    pitem_label,
-    pitem_offset,
-    pitem_value,
-
-) where
--- original code thanks to Neal Alexander
-
-import qualified Graphics.Rendering.Cairo as C
-
-import Data.List
-import Data.Bits
-import Data.Accessor.Template
-import Data.Colour
-import Data.Colour.Names (black, white)
-import Control.Monad
-
-import Graphics.Rendering.Chart.Types
-import Graphics.Rendering.Chart.Legend
-import Graphics.Rendering.Chart.Renderable
-import Graphics.Rendering.Chart.Grid
-
-data PieLayout = PieLayout {
-   pie_title_       :: String,
-   pie_title_style_ :: CairoFontStyle,
-   pie_plot_        :: PieChart,
-   pie_background_  :: CairoFillStyle,
-   pie_margin_      :: Double
-}
-
-data PieChart = PieChart {
-   pie_data_             :: [PieItem],
-   pie_colors_           :: [AlphaColour Double],
-   pie_label_style_      :: CairoFontStyle,
-   pie_label_line_style_ :: CairoLineStyle, 
-   pie_start_angle_      :: Double
-
-}
-
-data PieItem = PieItem {
-   pitem_label_  :: String,
-   pitem_offset_ :: Double,
-   pitem_value_  :: Double
-}
-
-defaultPieChart :: PieChart
-defaultPieChart = PieChart {
-    pie_data_             = [], 
-    pie_colors_           = defaultColorSeq,
-    pie_label_style_      = defaultFontStyle,
-    pie_label_line_style_ = solidLine 1 $ opaque black,
-    pie_start_angle_      = 0
-}
-
-defaultPieItem :: PieItem
-defaultPieItem = PieItem "" 0 0
-
-defaultPieLayout :: PieLayout
-defaultPieLayout = PieLayout {
-    pie_background_  = solidFillStyle $ opaque white,
-    pie_title_       = "",
-    pie_title_style_ = defaultFontStyle{ font_size_   = 15
-                                       , font_weight_ = C.FontWeightBold },
-    pie_plot_        = defaultPieChart,
-    pie_margin_      = 10
-}
-
-instance ToRenderable PieLayout where
-    toRenderable p = fillBackground (pie_background_ p) (
-       gridToRenderable $ aboveN
-         [ tval $ addMargins (lm/2,0,0,0) title
-         , weights (1,1) $ tval $ addMargins (lm,lm,lm,lm)
-                                             (toRenderable $ pie_plot_ p)
-         ] )
-      where
-        title = label (pie_title_style_ p) HTA_Centre VTA_Top (pie_title_ p)
-        lm    = pie_margin_ p
-
-instance ToRenderable PieChart where
-    toRenderable p = Renderable {
-      minsize = minsizePie p,
-      render  = renderPie p
-    }
-
-extraSpace p = do
-    textSizes <- mapM textSize (map pitem_label_ (pie_data_ p))
-    let maxw  = foldr (max.fst) 0 textSizes
-    let maxh  = foldr (max.snd) 0 textSizes
-    let maxo  = foldr (max.pitem_offset_) 0 (pie_data_ p)
-    let extra = label_rgap + label_rlength + maxo
-    return (extra + maxw, extra + maxh )
-
-minsizePie p = do
-    (extraw,extrah) <- extraSpace p
-    return (extraw * 2, extrah * 2)
-
-renderPie p (w,h) = do
-    (extraw,extrah) <- extraSpace p
-    let (w,h)  = (p_x p2 - p_x p1, p_y p2 - p_y p1)
-    let center = Point (p_x p1 + w/2)  (p_y p1 + h/2)
-    let radius = (min (w - 2*extraw) (h - 2*extrah)) / 2
-
-    foldM_ (paint center radius) (pie_start_angle_ p)
-           (zip (pie_colors_ p) content)
-    return nullPickFn
- 
-    where
-        p1 = Point 0 0 
-        p2 = Point w h 
-        content = let total = sum (map pitem_value_ (pie_data_ p))
-                  in [ pi{pitem_value_=pitem_value_ pi/total}
-                     | pi <- pie_data_ p ]
-
-        paint :: Point -> Double -> Double -> (AlphaColour Double, PieItem)
-                 -> CRender Double
-        paint center radius a1 (color,pitem) = do
-            let ax     = 360.0 * (pitem_value_ pitem)
-            let a2     = a1 + (ax / 2)
-            let a3     = a1 + ax
-            let offset = pitem_offset_ pitem
-
-            pieSlice (ray a2 offset) a1 a3 color
-            pieLabel (pitem_label_ pitem) a2 offset
-
-            return a3
-
-            where
-                pieLabel :: String -> Double -> Double -> CRender ()
-                pieLabel name angle offset = do
-                    setFontStyle (pie_label_style_ p)
-                    setLineStyle (pie_label_line_style_ p)
-
-                    moveTo (ray angle (radius + label_rgap+offset))
-                    let p1 = ray angle (radius+label_rgap+label_rlength+offset)
-                    lineTo p1
-                    (tw,th) <- textSize name
-                    let (offset,anchor) = if angle < 90 || angle > 270 
-                                          then ((0+),HTA_Left)
-                                          else ((0-),HTA_Right)
-                    c $ C.relLineTo (offset (tw + label_rgap)) 0
-                    c $ C.stroke
-
-                    let p2 = p1 `pvadd` (Vector (offset label_rgap) 0)
-                    drawText anchor VTA_Bottom p2 name
-
-                pieSlice :: Point -> Double -> Double -> AlphaColour Double
-                            -> CRender ()
-                pieSlice (Point x y) a1 a2 color = c $ do
-                    C.newPath
-                    C.arc x y radius (radian a1) (radian a2)
-                    C.lineTo x y
-                    C.lineTo x y
-                    C.closePath
-
-                    setSourceColor color
-                    C.fillPreserve
-                    C.setSourceRGBA 1 1 1 0.1
-
-                    C.stroke
-
-                ray :: Double -> Double -> Point
-                ray angle r = Point x' y'
-                  where
-                    x'   = x + (cos' * x'')
-                    y'   = y + (sin' * x'')
-                    cos' = (cos . radian) angle
-                    sin' = (sin . radian) angle
-                    x''  = ((x + r) - x)
-                    x    = p_x center
-                    y    = p_y center
-
-                radian = (*(pi / 180.0))
-
-
-label_rgap = 5
-label_rlength = 15
-
-----------------------------------------------------------------------
--- Template haskell to derive an instance of Data.Accessor.Accessor
--- for each field.
-$( deriveAccessors ''PieLayout )
-$( deriveAccessors ''PieChart )
-$( deriveAccessors ''PieItem )

@@ -4,676 +4,34 @@ -- Copyright   :  (c) Tim Docker 2006 -- License     :  BSD-style (see chart/COPYRIGHT) ----- Definitions of various types of Plots we can put on a 2D Chart.------ Note that template haskell is used to derive accessor functions--- (see 'Data.Accessor') for each field of the following data types:------     * 'Plot'------     * 'PlotLines'------     * 'PlotPoints'------     * 'PlotFillBetween'------     * 'PlotErrBars'------     * 'PlotBars'--- ---     * 'PlotHidden'------     * 'PlotAnnotation'------ These accessors are not shown in this API documentation.  They have--- the same name as the field, but with the trailing underscore--- dropped. Hence for data field f_::F in type D, they have type------ @---   f :: Data.Accessor.Accessor D F--- @+-- Code to calculate and render various types of plots. -- -+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-}  module Graphics.Rendering.Chart.Plot(-    -- * Plot-    Plot(..),-    joinPlot,-    -- ** Typeclass for casting to plot-    ToPlot(..),-    -- * Point plots-    PlotPoints(..),-    defaultPlotPoints,-    -- * Lines plot-    PlotLines(..),-    defaultPlotLines,-    defaultPlotLineStyle,-    hlinePlot,-    vlinePlot,-    -- * Plot with error bars-    PlotErrBars(..),-    defaultPlotErrBars,-    ErrPoint(..),-    ErrValue(..),-    symErrPoint,-    -- * Plot with filled area-    PlotFillBetween(..),-    defaultPlotFillBetween,-    -- * Bar plots-    PlotBars(..),-    defaultPlotBars,-    PlotBarsStyle(..),-    PlotBarsSpacing(..),-    PlotBarsAlignment(..),-    BarsPlotValue(..),-    -- * Invisible plot-    PlotHidden(..),-    -- Annotation plot-    PlotAnnotation(..),-    defaultPlotAnnotation,--    -- * Accessors-    -- | These accessors are generated by template haskell-    plot_lines_title,-    plot_lines_style,-    plot_lines_values,-    plot_lines_limit_values,--    plot_render,-    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_alignment,-    plot_bars_reference,-    plot_bars_singleton_width,-    plot_bars_values,--    plot_annotation_hanchor,-    plot_annotation_vanchor,-    plot_annotation_angle,-    plot_annotation_style,-    plot_annotation_values-    ) where--import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types-import Graphics.Rendering.Chart.Renderable-import Graphics.Rendering.Chart.Axis-import Control.Monad-import Data.List-import Data.Accessor.Template-import Data.Colour-import Data.Colour.SRGB (sRGB)-import Data.Colour.Names---- | Interface to control plotting on a 2D area.-data Plot x y = Plot {--    -- | Given the mapping between model space coordinates and device-    --   coordinates, render this plot into a chart.-    plot_render_     :: PointMapFn x y -> 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.-    plot_all_points_ :: ([x],[y])-}---- | A type class abstracting the conversion of a value to a Plot.-class ToPlot a where-   toPlot :: a x y -> Plot x y---- | Join any two plots together (they will share a legend).-joinPlot :: Plot x y -> Plot x y -> Plot x y-joinPlot Plot{ plot_render_     = renderP-             , plot_legend_     = legendP-             , plot_all_points_ = (xsP,ysP) }-         Plot{ plot_render_     = renderQ-             , plot_legend_     = legendQ-             , plot_all_points_ = (xsQ,ysQ) }--       = Plot{ plot_render_     = \a-> renderP a >> renderQ a-             , plot_legend_     = legendP ++ legendQ-             , plot_all_points_ = ( xsP++xsQ, ysP++ysQ )-             }---------------------------------------------------------------------------mapXY :: PointMapFn x y -> ((x,y) -> Point)-mapXY f (x,y) = f (LValue x, LValue y)---------------------------------------------------------------------------- | 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)]],-    plot_lines_limit_values_ :: [[(Limit x, Limit y)]]-}--instance ToPlot PlotLines where-    toPlot p = Plot {-        plot_render_     = renderPlotLines p,-        plot_legend_     = [(plot_lines_title_ p, renderPlotLegendLines p)],-        plot_all_points_ = ( map fst pts ++ xs, map snd pts ++ ys )-    }-      where-        pts = concat (plot_lines_values_ p)-        xs = [ x | (LValue x,_) <- concat (plot_lines_limit_values_ p)]-        ys = [ y | (_,LValue y) <- concat (plot_lines_limit_values_ p)]--renderPlotLines :: PlotLines x y -> PointMapFn x y -> CRender ()-renderPlotLines p pmap = preserveCState $ do-    setLineStyle (plot_lines_style_ p)-    mapM_ (drawLines (mapXY pmap)) (plot_lines_values_ p)-    mapM_ (drawLines pmap) (plot_lines_limit_values_ p)-  where-    drawLines mapfn pts = strokePath (map mapfn pts)--renderPlotLegendLines :: PlotLines x y -> Rect -> CRender ()-renderPlotLegendLines p r@(Rect p1 p2) = preserveCState $ do-    setLineStyle (plot_lines_style_ p)-    let y = (p_y p1 + p_y p2) / 2-    strokePath [Point (p_x p1) y, Point (p_x p2) y]--defaultPlotLineStyle :: CairoLineStyle-defaultPlotLineStyle = (solidLine 1 $ opaque blue){-     line_cap_  = C.LineCapRound,-     line_join_ = C.LineJoinRound- }--defaultPlotLines :: PlotLines x y-defaultPlotLines = PlotLines {-    plot_lines_title_        = "",-    plot_lines_style_        = defaultPlotLineStyle,-    plot_lines_values_       = [],-    plot_lines_limit_values_ = []-}---- | Helper function to plot a single horizontal line.-hlinePlot :: String -> CairoLineStyle -> b -> Plot a b-hlinePlot t ls v = toPlot defaultPlotLines {-    plot_lines_title_        = t,-    plot_lines_style_        = ls,-    plot_lines_limit_values_ = [[(LMin, LValue v),(LMax, LValue v)]]-    }---- | Helper function to plot a single vertical line.-vlinePlot :: String -> CairoLineStyle -> a -> Plot a b-vlinePlot t ls v = toPlot defaultPlotLines {-    plot_lines_title_        = t,-    plot_lines_style_        = ls,-    plot_lines_limit_values_ = [[(LValue v,LMin),(LValue v,LMax)]]-    }---------------------------------------------------------------------------- | 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)]-}---instance ToPlot PlotPoints where-    toPlot p = Plot {-        plot_render_     = renderPlotPoints p,-        plot_legend_     = [(plot_points_title_ p, renderPlotLegendPoints p)],-        plot_all_points_ = (map fst pts, map snd pts)-    }-      where-        pts = plot_points_values_ p--renderPlotPoints :: PlotPoints x y -> PointMapFn x y -> CRender ()-renderPlotPoints p pmap = preserveCState $ do-    mapM_ (drawPoint.pmap') (plot_points_values_ p)-  where-    pmap' = mapXY pmap-    (CairoPointStyle drawPoint) = (plot_points_style_ p)---renderPlotLegendPoints :: PlotPoints x y -> Rect -> CRender ()-renderPlotLegendPoints p r@(Rect p1 p2) = preserveCState $ do-    drawPoint (Point (p_x p1)              ((p_y p1 + p_y p2)/2))-    drawPoint (Point ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2))-    drawPoint (Point (p_x p2)              ((p_y p1 + p_y p2)/2))--  where-    (CairoPointStyle drawPoint) = (plot_points_style_ p)--defaultPlotPoints :: PlotPoints x y-defaultPlotPoints = PlotPoints {-    plot_points_title_  = "",-    plot_points_style_  = defaultPointStyle,-    plot_points_values_ = []-}-------------------------------------------------------------------------- | Value specifying a plot filling the area between two sets of Y---   coordinates, given common X coordinates.--data PlotFillBetween x y = PlotFillBetween {-    plot_fillbetween_title_  :: String,-    plot_fillbetween_style_  :: CairoFillStyle,-    plot_fillbetween_values_ :: [ (x, (y,y))]-}---instance ToPlot PlotFillBetween where-    toPlot p = Plot {-        plot_render_     = renderPlotFillBetween p,-        plot_legend_     = [(plot_fillbetween_title_ p,renderPlotLegendFill p)],-        plot_all_points_ = plotAllPointsFillBetween p-    }--renderPlotFillBetween :: PlotFillBetween x y -> PointMapFn x y -> CRender ()-renderPlotFillBetween p pmap =-    renderPlotFillBetween' p (plot_fillbetween_values_ p) pmap--renderPlotFillBetween' p [] _     = return ()-renderPlotFillBetween' p vs pmap  = preserveCState $ do-    setFillStyle (plot_fillbetween_style_ p)-    fillPath ([p0] ++ p1s ++ reverse p2s ++ [p0])-  where-    pmap'    = mapXY pmap-    (p0:p1s) = map pmap' [ (x,y1) | (x,(y1,y2)) <- vs ]-    p2s      = map pmap' [ (x,y2) | (x,(y1,y2)) <- vs ]--renderPlotLegendFill :: PlotFillBetween x y -> Rect -> CRender ()-renderPlotLegendFill p r = preserveCState $ do-    setFillStyle (plot_fillbetween_style_ p)-    fillPath (rectPath r)--plotAllPointsFillBetween :: PlotFillBetween x y -> ([x],[y])-plotAllPointsFillBetween p = ( [ x | (x,(_,_)) <- pts ]-                             , concat [ [y1,y2] | (_,(y1,y2)) <- pts ] )-  where-    pts = plot_fillbetween_values_ p---defaultPlotFillBetween :: PlotFillBetween x y-defaultPlotFillBetween = PlotFillBetween {-    plot_fillbetween_title_  = "",-    plot_fillbetween_style_  = solidFillStyle (opaque $ sRGB 0.5 0.5 1.0),-    plot_fillbetween_values_ = []-}---------------------------------------------------------------------------- | Value for holding a point with associated error bounds for each axis.--data ErrValue x = ErrValue {-      ev_low  :: x,-      ev_best :: x,-      ev_high :: x-} deriving Show--data ErrPoint x y = ErrPoint {-      ep_x :: ErrValue x,-      ep_y :: ErrValue y-} deriving Show---- | When the error is symmetric, we can simply pass in dx for the error.-symErrPoint :: (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b-symErrPoint x y dx dy = ErrPoint (ErrValue (x-dx) x (x+dx))-                                 (ErrValue (y-dy) y (y+dy))---- | 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,-    plot_errbars_values_      :: [ErrPoint x y]-}---instance ToPlot PlotErrBars where-    toPlot p = Plot {-        plot_render_     = renderPlotErrBars p,-        plot_legend_     = [(plot_errbars_title_ p, renderPlotLegendErrBars p)],-        plot_all_points_ = ( concat [ [ev_low x,ev_high x]-                                    | ErrPoint x _ <- pts ]-                           , concat [ [ev_low y,ev_high y]-                                    | ErrPoint _ y <- pts ] )-    }-      where-        pts = plot_errbars_values_ p--renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> CRender ()-renderPlotErrBars p pmap = preserveCState $ do-    mapM_ (drawErrBar.epmap) (plot_errbars_values_ p)-  where-    epmap (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) =-        ErrPoint (ErrValue xl' x' xh') (ErrValue yl' y' yh')-        where (Point x' y')   = pmap' (x,y)-              (Point xl' yl') = pmap' (xl,yl)-              (Point xh' yh') = pmap' (xh,yh)-    drawErrBar = drawErrBar0 p-    pmap'      = mapXY pmap--drawErrBar0 ps (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) = do-        let tl = plot_errbars_tick_length_ ps-        let oh = plot_errbars_overhang_ ps-        setLineStyle (plot_errbars_line_style_ ps)-        c $ C.newPath-        c $ C.moveTo (xl-oh) y-        c $ C.lineTo (xh+oh) y-        c $ C.moveTo x (yl-oh)-        c $ C.lineTo x (yh+oh)-        c $ C.moveTo xl (y-tl)-        c $ C.lineTo xl (y+tl)-        c $ C.moveTo (x-tl) yl-        c $ C.lineTo (x+tl) yl-        c $ C.moveTo xh (y-tl)-        c $ C.lineTo xh (y+tl)-        c $ C.moveTo (x-tl) yh-        c $ C.lineTo (x+tl) yh-	c $ C.stroke--renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> CRender ()-renderPlotLegendErrBars p r@(Rect p1 p2) = preserveCState $ do-    drawErrBar (symErrPoint (p_x p1)              ((p_y p1 + p_y p2)/2) dx dx)-    drawErrBar (symErrPoint ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2) dx dx)-    drawErrBar (symErrPoint (p_x p2)              ((p_y p1 + p_y p2)/2) dx dx)--  where-    drawErrBar = drawErrBar0 p-    dx         = min ((p_x p2 - p_x p1)/6) ((p_y p2 - p_y p1)/2)--defaultPlotErrBars :: PlotErrBars x y-defaultPlotErrBars = PlotErrBars {-    plot_errbars_title_       = "",-    plot_errbars_line_style_  = solidLine 1 $ opaque blue,-    plot_errbars_tick_length_ = 3,-    plot_errbars_overhang_    = 0,-    plot_errbars_values_      = []-}--------------------------------------------------------------------------class PlotValue a => BarsPlotValue a where-    barsReference :: a-    barsAdd       :: a -> a -> a--instance BarsPlotValue Double where-    barsReference = 0-    barsAdd       = (+)-instance BarsPlotValue Int where-    barsReference = 0-    barsAdd       = (+)--data PlotBarsStyle-    = BarsStacked   -- ^ Bars for a fixed x are stacked vertically-                    --   on top of each other.-    | BarsClustered -- ^ Bars for a fixed x are put horizontally-                    --   beside each other.-     deriving (Show)--data PlotBarsSpacing-    = BarsFixWidth Double       -- ^ All bars have the same width in pixels.-    | BarsFixGap Double Double  -- ^ (BarsFixGap g mw) means make the gaps between-                                --   the bars equal to g, but with a minimum bar width-                                --   of mw-     deriving (Show)---- | How bars for a given (x,[y]) are aligned with respect to screen---   coordinate corresponding to x (deviceX).-data PlotBarsAlignment = BarsLeft      -- ^ The left edge of bars is at deviceX-                       | BarsCentered  -- ^ The right edge of bars is at deviceX-                       | BarsRight     -- ^ Bars are centered around deviceX-     deriving (Show)---- | 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,--   -- | This value controls how bars for a fixed x are aligned with-   --   respect to the device coordinate corresponding to x.-   plot_bars_alignment_       :: PlotBarsAlignment,--   -- | The starting level for the chart (normally 0).-   plot_bars_reference_       :: y,--   plot_bars_singleton_width_ :: Double,--   -- | 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 2,-   plot_bars_alignment_       = BarsCentered,-   plot_bars_values_          = [],-   plot_bars_singleton_width_ = 20,-   plot_bars_reference_       = barsReference-   }-  where-    istyles   = map mkstyle defaultColorSeq-    mkstyle c = (solidFillStyle c, Just (solidLine 1.0 $ opaque 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 -> 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-           fillPath (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-             strokePath (barPath (offset i) x yref0 y)--    offset = case (plot_bars_alignment_ p) of-      BarsLeft     -> \i -> fromIntegral i * width-      BarsRight    -> \i -> fromIntegral (i-nys) * width-      BarsCentered -> \i -> fromIntegral (2*i-nys) * width/2--    stackedBars (x,ys) =  preserveCState $ do-       let y2s = zip (yref0:stack ys) (stack ys)-       let ofs = case (plot_bars_alignment_ p) of {-         BarsLeft     -> 0          ;-         BarsRight    -> (-width)   ;-         BarsCentered -> (-width/2)-         }-       forM_ (zip y2s styles) $ \((y0,y1), (fstyle,_)) -> do-           setFillStyle fstyle-           fillPath (barPath ofs x y0 y1)-       forM_ (zip y2s styles) $ \((y0,y1), (_,mlstyle)) -> do-           whenJust mlstyle $ \lstyle -> do-               setLineStyle lstyle-               strokePath (barPath ofs x y0 y1)--    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 minw -> let w = max (minXInterval - gap) minw in-            case (plot_bars_style_ p) of-                BarsClustered -> w / fromIntegral nys-                BarsStacked -> w-        BarsFixWidth width -> width-    styles = plot_bars_item_styles_ p--    minXInterval = let diffs = zipWith (-) (tail mxs) mxs-                   in if null diffs-                        then plot_bars_singleton_width_ p-                        else minimum diffs-      where-        xs  = fst (allBarPoints p)-        mxs = nub $ sort $ map mapX xs--    nys    = maximum [ length ys | (x,ys) <- vals ]--    pmap'  = mapXY pmap-    mapX x = p_x (pmap' (x,barsReference))--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 -> ( [x| (x,_) <- pts], y0:concat [ys| (_,ys) <- pts] )-    BarsStacked   -> ( [x| (x,_) <- pts], y0:concat [stack ys | (_,ys) <- pts] )-  where-    pts = plot_bars_values_ p-    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-    fillPath (rectPath r)---------------------------------------------------------------------------- | Value defining some hidden x and y values. The values don't---   get displayed, but still affect axis scaling.-data PlotHidden x y = PlotHidden {-    plot_hidden_x_values_ :: [x],-    plot_hidden_y_values_ :: [y]-}--instance ToPlot PlotHidden where-    toPlot ph = Plot {-        plot_render_     = \_ -> return (),-        plot_legend_     = [],-        plot_all_points_ = (plot_hidden_x_values_ ph, plot_hidden_y_values_ ph)-    }------------------------------------------------------------------------------ | Value for describing a series of text annotations---   to be placed at arbitrary points on the graph. Annotations---   can be rotated and styled. Rotation angle is given in degrees,---   rotation is performend around the anchor point.--data PlotAnnotation  x y = PlotAnnotation {-      plot_annotation_hanchor_ :: HTextAnchor,-      plot_annotation_vanchor_ :: VTextAnchor,-      plot_annotation_angle_   :: Double,-      plot_annotation_style_   :: CairoFontStyle,-      plot_annotation_values_  :: [(x,y,String)]-}---instance ToPlot PlotAnnotation where-    toPlot p = Plot {-        plot_render_ = renderAnnotation p,-	plot_legend_ = [],-	plot_all_points_ = (map (\(x,_,_)->x)  vs , map (\(_,y,_)->y) vs)-    }-      where-        vs = plot_annotation_values_ p---renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> CRender ()--renderAnnotation p pMap = preserveCState $ do-                            setFontStyle style                            -                            mapM_ drawOne values-    where hta = plot_annotation_hanchor_ p-          vta = plot_annotation_vanchor_ p-          values = plot_annotation_values_ p-          angle =  plot_annotation_angle_ p-          style =  plot_annotation_style_ p-          drawOne (x,y,s) = drawTextR hta vta angle point s-              where point = pMap (LValue x, LValue y)--defaultPlotAnnotation = PlotAnnotation {-                          plot_annotation_hanchor_ = HTA_Centre,-                          plot_annotation_vanchor_ = VTA_Centre,-                          plot_annotation_angle_   = 0,-                          plot_annotation_style_   = defaultFontStyle,-                          plot_annotation_values_  = []-}--+    module Graphics.Rendering.Chart.Plot.Types,+    module Graphics.Rendering.Chart.Plot.Lines,+    module Graphics.Rendering.Chart.Plot.Points,+    module Graphics.Rendering.Chart.Plot.FillBetween,+    module Graphics.Rendering.Chart.Plot.ErrBars,+    module Graphics.Rendering.Chart.Plot.Candle,+    module Graphics.Rendering.Chart.Plot.Bars,+    module Graphics.Rendering.Chart.Plot.Hidden,+    module Graphics.Rendering.Chart.Plot.Annotation,+    module Graphics.Rendering.Chart.Plot.AreaSpots,+    module Graphics.Rendering.Chart.Plot.Pie,+) where -------------------------------------------------------------------------- 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 )-$( deriveAccessors ''PlotHidden )-$( deriveAccessors ''PlotAnnotation )+import Graphics.Rendering.Chart.Plot.Types+import Graphics.Rendering.Chart.Plot.Lines+import Graphics.Rendering.Chart.Plot.Points+import Graphics.Rendering.Chart.Plot.FillBetween+import Graphics.Rendering.Chart.Plot.ErrBars+import Graphics.Rendering.Chart.Plot.Candle+import Graphics.Rendering.Chart.Plot.Bars+import Graphics.Rendering.Chart.Plot.Hidden+import Graphics.Rendering.Chart.Plot.Annotation+import Graphics.Rendering.Chart.Plot.AreaSpots+import Graphics.Rendering.Chart.Plot.Pie

@@ -0,0 +1,80 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.Annotation+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Show textual annotations on a chart.++{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.Annotation(+    PlotAnnotation(..),+    defaultPlotAnnotation,++    plot_annotation_hanchor,+    plot_annotation_vanchor,+    plot_annotation_angle,+    plot_annotation_style,+    plot_annotation_values+) where++import Data.Accessor.Template+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Plot.Types+import Data.Colour (opaque)+import Data.Colour.Names (black, blue)+import Data.Colour.SRGB (sRGB)+-- | Value for describing a series of text annotations+--   to be placed at arbitrary points on the graph. Annotations+--   can be rotated and styled. Rotation angle is given in degrees,+--   rotation is performend around the anchor point.++data PlotAnnotation  x y = PlotAnnotation {+      plot_annotation_hanchor_ :: HTextAnchor,+      plot_annotation_vanchor_ :: VTextAnchor,+      plot_annotation_angle_   :: Double,+      plot_annotation_style_   :: CairoFontStyle,+      plot_annotation_values_  :: [(x,y,String)]+}+++instance ToPlot PlotAnnotation where+    toPlot p = Plot {+        plot_render_ = renderAnnotation p,+	plot_legend_ = [],+	plot_all_points_ = (map (\(x,_,_)->x)  vs , map (\(_,y,_)->y) vs)+    }+      where+        vs = plot_annotation_values_ p+++renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> CRender ()++renderAnnotation p pMap = preserveCState $ do+                            setFontStyle style                            +                            mapM_ drawOne values+    where hta = plot_annotation_hanchor_ p+          vta = plot_annotation_vanchor_ p+          values = plot_annotation_values_ p+          angle =  plot_annotation_angle_ p+          style =  plot_annotation_style_ p+          drawOne (x,y,s) = drawTextsR hta vta angle point s+              where point = pMap (LValue x, LValue y)++defaultPlotAnnotation = PlotAnnotation {+                          plot_annotation_hanchor_ = HTA_Centre,+                          plot_annotation_vanchor_ = VTA_Centre,+                          plot_annotation_angle_   = 0,+                          plot_annotation_style_   = defaultFontStyle,+                          plot_annotation_values_  = []+}++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.++$( deriveAccessors ''PlotAnnotation )+

@@ -0,0 +1,202 @@+-- |+-- Module     :  Graphics.Rendering.Chart.Plot.AreaSpots+-- Copyright  :  (c) Malcolm Wallace 2009+-- License    :  BSD-style (see COPYRIGHT file)+--+-- Area spots are a collection of unconnected filled circles,+-- with x,y position, and an independent z value to be represented+-- by the relative area of the spots.++{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.AreaSpots+  ( AreaSpots(..)+  , defaultAreaSpots++  , area_spots_title+  , area_spots_linethick+  , area_spots_linecolour+  , area_spots_fillcolour+  , area_spots_max_radius+  , area_spots_values++  , AreaSpots4D(..)+  , defaultAreaSpots4D++  , area_spots_4d_title+  , area_spots_4d_linethick+  , area_spots_4d_palette+  , area_spots_4d_max_radius+  , area_spots_4d_values+  ) where++import qualified Graphics.Rendering.Cairo as C++import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Plot.Types+import Graphics.Rendering.Chart.Axis+import Data.Accessor.Template+import Data.Colour+import Data.Colour.Names++import Control.Monad+++-- stuff that belongs in Data.Tuple+fst3 (a,_,_) = a+snd3 (_,a,_) = a+thd3 (_,_,a) = a++fst4 (a,_,_,_) = a+snd4 (_,a,_,_) = a+thd4 (_,_,a,_) = a+fth4 (_,_,_,a) = a+++-- | A collection of unconnected spots, with x,y position, and an+--   independent z value to be represented by the area of the spot.+data AreaSpots z x y = AreaSpots+  { area_spots_title_      :: String+  , area_spots_linethick_  :: Double+  , area_spots_linecolour_ :: AlphaColour Double+  , area_spots_fillcolour_ :: AlphaColour Double+  , area_spots_max_radius_ :: Double	-- ^ the largest size of spot+  , area_spots_values_     :: [(x,y,z)]+  }++defaultAreaSpots :: AreaSpots z x y+defaultAreaSpots = AreaSpots+  { area_spots_title_      = ""+  , area_spots_linethick_  = 0.1+  , area_spots_linecolour_ = opaque blue+  , area_spots_fillcolour_ = flip withOpacity 0.2 blue+  , area_spots_max_radius_ = 20  -- in pixels+  , area_spots_values_     = []+  }++instance (PlotValue z) => ToPlot (AreaSpots z) where+    toPlot p = Plot { plot_render_ = renderAreaSpots p+                    , plot_legend_ = [(area_spots_title_ p, renderSpotLegend p)]+                    , plot_all_points_ = ( map fst3 (area_spots_values_ p)+                                         , map snd3 (area_spots_values_ p) )+                    }++renderAreaSpots  :: (PlotValue z) =>+                    AreaSpots z x y -> PointMapFn x y -> CRender ()+renderAreaSpots p pmap = preserveCState $+    forM_ (scaleMax ((area_spots_max_radius_ p)^2)+                    (area_spots_values_ p))+          (\ (x,y,z)-> do+              let radius = sqrt z+              let (CairoPointStyle drawSpotAt)    = filledCircles radius+                                                      (area_spots_fillcolour_ p)+              drawSpotAt (pmap (LValue x, LValue y))+              let (CairoPointStyle drawOutlineAt) = hollowCircles radius+                                                      (area_spots_linethick_ p)+                                                      (area_spots_linecolour_ p)+              drawOutlineAt (pmap (LValue x, LValue y))+          )+  where+    scaleMax :: PlotValue z => Double -> [(x,y,z)] -> [(x,y,Double)]+    scaleMax n points = let largest  = maximum (map (toValue . thd3) points)+                            scale v  = n * toValue v / largest+                        in map (\ (x,y,z) -> (x,y, scale z)) points++renderSpotLegend :: AreaSpots z x y -> Rect -> CRender ()+renderSpotLegend p r@(Rect p1 p2) = preserveCState $ do+    let radius = min (abs (p_y p1 - p_y p2)) (abs (p_x p1 - p_x p2))+        centre = linearInterpolate p1 p2+    let (CairoPointStyle drawSpotAt)    = filledCircles radius+                                            (area_spots_fillcolour_ p)+    drawSpotAt centre+    let (CairoPointStyle drawOutlineAt) = hollowCircles radius+                                            (area_spots_linethick_ p)+                                            (area_spots_linecolour_ p)+    drawOutlineAt centre+  where+    linearInterpolate (Point x0 y0) (Point x1 y1) =+        Point (x0 + abs(x1-x0)/2) (y0 + abs(y1-y0)/2)++-- | A collection of unconnected spots, with x,y position, an+--   independent z value to be represented by the area of the spot,+--   and in addition, a fourth variable t to be represented by a colour+--   from a given palette.  (A linear transfer function from t to palette+--   is assumed.)+data AreaSpots4D z t x y = AreaSpots4D+  { area_spots_4d_title_      :: String+  , area_spots_4d_linethick_  :: Double+  , area_spots_4d_palette_    :: [Colour Double]+  , area_spots_4d_max_radius_ :: Double	-- ^ the largest size of spot+  , area_spots_4d_values_     :: [(x,y,z,t)]+  }++defaultAreaSpots4D :: AreaSpots4D z t x y+defaultAreaSpots4D = AreaSpots4D+  { area_spots_4d_title_      = ""+  , area_spots_4d_linethick_  = 0.1+  , area_spots_4d_palette_    = [ blue, green, yellow, orange, red ]+  , area_spots_4d_max_radius_ = 20  -- in pixels+  , area_spots_4d_values_     = []+  }++instance (PlotValue z, PlotValue t, Show t) => ToPlot (AreaSpots4D z t) where+    toPlot p = Plot { plot_render_ = renderAreaSpots4D p+                    , plot_legend_ = [ (area_spots_4d_title_ p+                                       , renderSpotLegend4D p) ]+                    , plot_all_points_ = ( map fst4 (area_spots_4d_values_ p)+                                         , map snd4 (area_spots_4d_values_ p) )+                    }++renderAreaSpots4D  :: (PlotValue z, PlotValue t, Show t) =>+                      AreaSpots4D z t x y -> PointMapFn x y -> CRender ()+renderAreaSpots4D p pmap = preserveCState $+    forM_ (scaleMax ((area_spots_4d_max_radius_ p)^2)+                    (length (area_spots_4d_palette_ p))+                    (area_spots_4d_values_ p))+          (\ (x,y,z,t)-> do+              let radius  = sqrt z+              let colour  = (area_spots_4d_palette_ p) !! t +              let (CairoPointStyle drawSpotAt)+                    = filledCircles radius (flip withOpacity 0.2 colour)+              drawSpotAt (pmap (LValue x, LValue y))+              let (CairoPointStyle drawOutlineAt)+                    = hollowCircles radius (area_spots_4d_linethick_ p)+                                           (opaque colour)+              drawOutlineAt (pmap (LValue x, LValue y))+          )+  where+    scaleMax :: (PlotValue z, PlotValue t, Show t) =>+                Double -> Int -> [(x,y,z,t)] -> [(x,y,Double,Int)]+    scaleMax n c points = let largest  = maximum (map (toValue . thd4) points)+                              scale v  = n * toValue v / largest+                              colVals  = map (toValue . fth4) points+                              colMin   = minimum colVals+                              colMax   = maximum colVals+                              select t = min (c-1) $ +                                         truncate ( fromIntegral c+                                                       * (toValue t-colMin)+                                                       / (colMax-colMin))+                          in map (\ (x,y,z,t) -> (x,y, scale z, select t))+                                 points++renderSpotLegend4D :: AreaSpots4D z t x y -> Rect -> CRender ()+renderSpotLegend4D p r@(Rect p1 p2) = preserveCState $ do+    let radius = min (abs (p_y p1 - p_y p2)) (abs (p_x p1 - p_x p2))+        centre = linearInterpolate p1 p2+    let (CairoPointStyle drawSpotAt)    = filledCircles radius+                                            (flip withOpacity 0.2 $+                                             head (area_spots_4d_palette_ p))+    drawSpotAt centre+    let (CairoPointStyle drawOutlineAt) = hollowCircles radius+                                            (area_spots_4d_linethick_ p)+                                            (opaque $+                                             head (area_spots_4d_palette_ p))+    drawOutlineAt centre+  where+    linearInterpolate (Point x0 y0) (Point x1 y1) =+        Point (x0 + abs(x1-x0)/2) (y0 + abs(y1-y0)/2)++-------------------------------------------------------------------------+-- Template haskell to derive Data.Accessor.Accessor+$( deriveAccessors ''AreaSpots )+$( deriveAccessors ''AreaSpots4D )

@@ -0,0 +1,225 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.Bars+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Bar Charts+--+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.Bars(+    PlotBars(..),+    defaultPlotBars,+    PlotBarsStyle(..),+    PlotBarsSpacing(..),+    PlotBarsAlignment(..),+    BarsPlotValue(..),++    plotBars,+    plot_bars_style,+    plot_bars_item_styles,+    plot_bars_titles,+    plot_bars_spacing,+    plot_bars_alignment,+    plot_bars_reference,+    plot_bars_singleton_width,+    plot_bars_values,++) where++import Data.Accessor.Template+import Control.Monad+import Data.List(nub,sort)+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Plot.Types+import Graphics.Rendering.Chart.Axis+import Data.Colour (opaque)+import Data.Colour.Names (black, blue)+import Data.Colour.SRGB (sRGB)++class PlotValue a => BarsPlotValue a where+    barsReference :: a+    barsAdd       :: a -> a -> a++instance BarsPlotValue Double where+    barsReference = 0+    barsAdd       = (+)+instance BarsPlotValue Int where+    barsReference = 0+    barsAdd       = (+)++data PlotBarsStyle+    = BarsStacked   -- ^ Bars for a fixed x are stacked vertically+                    --   on top of each other.+    | BarsClustered -- ^ Bars for a fixed x are put horizontally+                    --   beside each other.+     deriving (Show)++data PlotBarsSpacing+    = BarsFixWidth Double       -- ^ All bars have the same width in pixels.+    | BarsFixGap Double Double  -- ^ (BarsFixGap g mw) means make the gaps between+                                --   the bars equal to g, but with a minimum bar width+                                --   of mw+     deriving (Show)++-- | How bars for a given (x,[y]) are aligned with respect to screen+--   coordinate corresponding to x (deviceX).+data PlotBarsAlignment = BarsLeft      -- ^ The left edge of bars is at deviceX+                       | BarsCentered  -- ^ The right edge of bars is at deviceX+                       | BarsRight     -- ^ Bars are centered around deviceX+     deriving (Show)++-- | 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,++   -- | This value controls how bars for a fixed x are aligned with+   --   respect to the device coordinate corresponding to x.+   plot_bars_alignment_       :: PlotBarsAlignment,++   -- | The starting level for the chart (normally 0).+   plot_bars_reference_       :: y,++   plot_bars_singleton_width_ :: Double,++   -- | 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 2,+   plot_bars_alignment_       = BarsCentered,+   plot_bars_values_          = [],+   plot_bars_singleton_width_ = 20,+   plot_bars_reference_       = barsReference+   }+  where+    istyles   = map mkstyle defaultColorSeq+    mkstyle c = (solidFillStyle c, Just (solidLine 1.0 $ opaque 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 -> 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+           fillPath (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+             strokePath (barPath (offset i) x yref0 y)++    offset = case (plot_bars_alignment_ p) of+      BarsLeft     -> \i -> fromIntegral i * width+      BarsRight    -> \i -> fromIntegral (i-nys) * width+      BarsCentered -> \i -> fromIntegral (2*i-nys) * width/2++    stackedBars (x,ys) =  preserveCState $ do+       let y2s = zip (yref0:stack ys) (stack ys)+       let ofs = case (plot_bars_alignment_ p) of {+         BarsLeft     -> 0          ;+         BarsRight    -> (-width)   ;+         BarsCentered -> (-width/2)+         }+       forM_ (zip y2s styles) $ \((y0,y1), (fstyle,_)) -> do+           setFillStyle fstyle+           fillPath (barPath ofs x y0 y1)+       forM_ (zip y2s styles) $ \((y0,y1), (_,mlstyle)) -> do+           whenJust mlstyle $ \lstyle -> do+               setLineStyle lstyle+               strokePath (barPath ofs x y0 y1)++    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 minw -> let w = max (minXInterval - gap) minw in+            case (plot_bars_style_ p) of+                BarsClustered -> w / fromIntegral nys+                BarsStacked -> w+        BarsFixWidth width -> width+    styles = plot_bars_item_styles_ p++    minXInterval = let diffs = zipWith (-) (tail mxs) mxs+                   in if null diffs+                        then plot_bars_singleton_width_ p+                        else minimum diffs+      where+        xs  = fst (allBarPoints p)+        mxs = nub $ sort $ map mapX xs++    nys    = maximum [ length ys | (x,ys) <- vals ]++    pmap'  = mapXY pmap+    mapX x = p_x (pmap' (x,barsReference))++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 -> ( [x| (x,_) <- pts], y0:concat [ys| (_,ys) <- pts] )+    BarsStacked   -> ( [x| (x,_) <- pts], y0:concat [stack ys | (_,ys) <- pts] )+  where+    pts = plot_bars_values_ p+    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+    fillPath (rectPath r)++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.++$( deriveAccessors ''PlotBars )+

@@ -0,0 +1,165 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.Candle+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Candlestick charts for financial plotting+--+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.Candle(+    PlotCandle(..),+    Candle(..),+    defaultPlotCandle,++    plot_candle_title,+    plot_candle_line_style,+    plot_candle_tick_length,+    plot_candle_width,+    plot_candle_centre,+    plot_candle_fill,+    plot_candle_rise_fill_style,+    plot_candle_fall_fill_style,+    plot_candle_values,+) where++import Data.Accessor.Template+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Plot.Types+import Control.Monad+import Data.Colour (opaque)+import Data.Colour.Names (black, white, blue)+import Data.Colour.SRGB (sRGB)++-- | Value defining a financial interval: opening and closing prices, with+--   maxima and minima; and a style in which to render them.+--   By convention, there are different fill styles depending on whether+--   the price rises (open < close) or falls (close < open).+--   (This plot type can also be re-purposed for statistical intervals, e.g.+--    minimum, first quartile, median, third quartile, maximum.)+data PlotCandle x y = PlotCandle {+    plot_candle_title_           :: String,+    plot_candle_line_style_      :: CairoLineStyle,+    plot_candle_fill_            :: Bool,+    plot_candle_rise_fill_style_ :: CairoFillStyle,+    plot_candle_fall_fill_style_ :: CairoFillStyle,+    plot_candle_tick_length_     :: Double,+    plot_candle_width_           :: Double,+    plot_candle_centre_          :: Double,+    plot_candle_values_          :: [Candle x y]+}++-- | A Value holding price intervals for a given x-coord.+--   An alternative view is that these are statistical intervals: the+--   0th, 25th, 50th, 75th, and 100th percentiles.+data Candle x y = Candle { candle_x     :: x+                         , candle_low   :: y+                         , candle_open  :: y+                         , candle_mid   :: y+                         , candle_close :: y+                         , candle_high  :: y+                         } deriving (Show)++instance ToPlot PlotCandle where+    toPlot p = Plot {+        plot_render_     = renderPlotCandle p,+        plot_legend_     = [(plot_candle_title_ p, renderPlotLegendCandle p)],+        plot_all_points_ = ( map candle_x pts+                           , concat [ [candle_low c, candle_high c]+                                    | c <- pts ] )+    }+      where+        pts = plot_candle_values_ p++renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> CRender ()+renderPlotCandle p pmap = preserveCState $ do+    mapM_ (drawCandle p . candlemap) (plot_candle_values_ p)+  where+    candlemap (Candle x lo op mid cl hi) =+        Candle x' lo' op' mid' cl' hi'+        where (Point x' mid')  = pmap' (x,mid)+              (Point _  lo')   = pmap' (x,lo)+              (Point _  op')   = pmap' (x,op)+              (Point _  cl')   = pmap' (x,cl)+              (Point _  hi')   = pmap' (x,hi)+    pmap' = mapXY pmap++drawCandle ps (Candle x lo open mid close hi) = do+        let tl = plot_candle_tick_length_ ps+        let wd = plot_candle_width_ ps+        let ct = plot_candle_centre_ ps+        let f  = plot_candle_fill_ ps+        -- the pixel coordinate system is inverted wrt the value coords.+        when f $ do setFillStyle (if open >= close+                                  then plot_candle_rise_fill_style_ ps+                                  else plot_candle_fall_fill_style_ ps)++                    c $ C.newPath+                    c $ C.moveTo (x-wd) open+                    c $ C.lineTo (x-wd) close+                    c $ C.lineTo (x+wd) close+                    c $ C.lineTo (x+wd) open+                    c $ C.lineTo (x-wd) open+                    c $ C.fill++        setLineStyle (plot_candle_line_style_ ps)+        c $ C.newPath+        c $ C.moveTo (x-wd) open+        c $ C.lineTo (x-wd) close+        c $ C.lineTo (x+wd) close+        c $ C.lineTo (x+wd) open+        c $ C.lineTo (x-wd) open+        c $ C.stroke++        c $ C.newPath+        c $ C.moveTo x (min lo hi)+        c $ C.lineTo x (min open close)+        c $ C.moveTo x (max open close)+        c $ C.lineTo x (max hi lo)+        c $ C.stroke++        when (tl > 0) $ do c $ C.newPath+                           c $ C.moveTo (x-tl) lo+                           c $ C.lineTo (x+tl) lo+                           c $ C.moveTo (x-tl) hi+                           c $ C.lineTo (x+tl) hi+                           c $ C.stroke++        when (ct > 0) $ do c $ C.moveTo (x-ct) mid+                           c $ C.lineTo (x+ct) mid+                           c $ C.stroke++renderPlotLegendCandle :: PlotCandle x y -> Rect -> CRender ()+renderPlotLegendCandle p r@(Rect p1 p2) = preserveCState $ do+    drawCandle p{ plot_candle_width_ = 2}+                      (Candle ((p_x p1 + p_x p2)*1/4) lo open mid close hi)+    drawCandle p{ plot_candle_width_ = 2}+                      (Candle ((p_x p1 + p_x p2)*2/3) lo close mid open hi)+  where+    lo    = max (p_y p1) (p_y p2)+    mid   = (p_y p1 + p_y p2)/2+    hi    = min (p_y p1) (p_y p2)+    open  = (lo + mid) / 2+    close = (mid + hi) / 2++defaultPlotCandle :: PlotCandle x y+defaultPlotCandle = PlotCandle {+    plot_candle_title_       = "",+    plot_candle_line_style_  = solidLine 1 $ opaque blue,+    plot_candle_fill_        = False,+    plot_candle_rise_fill_style_  = solidFillStyle $ opaque white,+    plot_candle_fall_fill_style_  = solidFillStyle $ opaque blue,+    plot_candle_tick_length_ = 2,+    plot_candle_width_       = 5,+    plot_candle_centre_      = 0,+    plot_candle_values_      = []+}++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.++$( deriveAccessors ''PlotCandle )

@@ -0,0 +1,132 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.ErrBars+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Plot series of points with associated error bars.+--+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.ErrBars(+    PlotErrBars(..),+    defaultPlotErrBars,+    ErrPoint(..),+    ErrValue(..),+    symErrPoint,++    -- * Accessors+    -- | These accessors are generated by template haskell++    plot_errbars_title,+    plot_errbars_line_style,+    plot_errbars_tick_length,+    plot_errbars_overhang,+    plot_errbars_values,+) where++import Data.Accessor.Template+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Plot.Types+import Data.Colour (opaque)+import Data.Colour.Names (black, blue)+import Data.Colour.SRGB (sRGB)++-- | Value for holding a point with associated error bounds for each axis.++data ErrValue x = ErrValue {+      ev_low  :: x,+      ev_best :: x,+      ev_high :: x+} deriving Show++data ErrPoint x y = ErrPoint {+      ep_x :: ErrValue x,+      ep_y :: ErrValue y+} deriving Show++-- | When the error is symmetric, we can simply pass in dx for the error.+symErrPoint :: (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b+symErrPoint x y dx dy = ErrPoint (ErrValue (x-dx) x (x+dx))+                                 (ErrValue (y-dy) y (y+dy))++-- | 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,+    plot_errbars_values_      :: [ErrPoint x y]+}+++instance ToPlot PlotErrBars where+    toPlot p = Plot {+        plot_render_     = renderPlotErrBars p,+        plot_legend_     = [(plot_errbars_title_ p, renderPlotLegendErrBars p)],+        plot_all_points_ = ( concat [ [ev_low x,ev_high x]+                                    | ErrPoint x _ <- pts ]+                           , concat [ [ev_low y,ev_high y]+                                    | ErrPoint _ y <- pts ] )+    }+      where+        pts = plot_errbars_values_ p++renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> CRender ()+renderPlotErrBars p pmap = preserveCState $ do+    mapM_ (drawErrBar.epmap) (plot_errbars_values_ p)+  where+    epmap (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) =+        ErrPoint (ErrValue xl' x' xh') (ErrValue yl' y' yh')+        where (Point x' y')   = pmap' (x,y)+              (Point xl' yl') = pmap' (xl,yl)+              (Point xh' yh') = pmap' (xh,yh)+    drawErrBar = drawErrBar0 p+    pmap'      = mapXY pmap++drawErrBar0 ps (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) = do+        let tl = plot_errbars_tick_length_ ps+        let oh = plot_errbars_overhang_ ps+        setLineStyle (plot_errbars_line_style_ ps)+        c $ C.newPath+        c $ C.moveTo (xl-oh) y+        c $ C.lineTo (xh+oh) y+        c $ C.moveTo x (yl-oh)+        c $ C.lineTo x (yh+oh)+        c $ C.moveTo xl (y-tl)+        c $ C.lineTo xl (y+tl)+        c $ C.moveTo (x-tl) yl+        c $ C.lineTo (x+tl) yl+        c $ C.moveTo xh (y-tl)+        c $ C.lineTo xh (y+tl)+        c $ C.moveTo (x-tl) yh+        c $ C.lineTo (x+tl) yh+	c $ C.stroke++renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> CRender ()+renderPlotLegendErrBars p r@(Rect p1 p2) = preserveCState $ do+    drawErrBar (symErrPoint (p_x p1)              ((p_y p1 + p_y p2)/2) dx dx)+    drawErrBar (symErrPoint ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2) dx dx)+    drawErrBar (symErrPoint (p_x p2)              ((p_y p1 + p_y p2)/2) dx dx)++  where+    drawErrBar = drawErrBar0 p+    dx         = min ((p_x p2 - p_x p1)/6) ((p_y p2 - p_y p1)/2)++defaultPlotErrBars :: PlotErrBars x y+defaultPlotErrBars = PlotErrBars {+    plot_errbars_title_       = "",+    plot_errbars_line_style_  = solidLine 1 $ opaque blue,+    plot_errbars_tick_length_ = 3,+    plot_errbars_overhang_    = 0,+    plot_errbars_values_      = []+}++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.++$( deriveAccessors ''PlotErrBars )

@@ -0,0 +1,84 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.FillBetween+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Plots that fill the area between two lines.+--+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.FillBetween(+    PlotFillBetween(..),+    defaultPlotFillBetween,++    -- * Accessors+    -- | These accessors are generated by template haskell+    plot_fillbetween_title,+    plot_fillbetween_style,+    plot_fillbetween_values,+) where++import Data.Accessor.Template+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Plot.Types+import Data.Colour (opaque)+import Data.Colour.Names (black, blue)+import Data.Colour.SRGB (sRGB)++-- | Value specifying a plot filling the area between two sets of Y+--   coordinates, given common X coordinates.++data PlotFillBetween x y = PlotFillBetween {+    plot_fillbetween_title_  :: String,+    plot_fillbetween_style_  :: CairoFillStyle,+    plot_fillbetween_values_ :: [ (x, (y,y))]+}+++instance ToPlot PlotFillBetween where+    toPlot p = Plot {+        plot_render_     = renderPlotFillBetween p,+        plot_legend_     = [(plot_fillbetween_title_ p,renderPlotLegendFill p)],+        plot_all_points_ = plotAllPointsFillBetween p+    }++renderPlotFillBetween :: PlotFillBetween x y -> PointMapFn x y -> CRender ()+renderPlotFillBetween p pmap =+    renderPlotFillBetween' p (plot_fillbetween_values_ p) pmap++renderPlotFillBetween' p [] _     = return ()+renderPlotFillBetween' p vs pmap  = preserveCState $ do+    setFillStyle (plot_fillbetween_style_ p)+    fillPath ([p0] ++ p1s ++ reverse p2s ++ [p0])+  where+    pmap'    = mapXY pmap+    (p0:p1s) = map pmap' [ (x,y1) | (x,(y1,y2)) <- vs ]+    p2s      = map pmap' [ (x,y2) | (x,(y1,y2)) <- vs ]++renderPlotLegendFill :: PlotFillBetween x y -> Rect -> CRender ()+renderPlotLegendFill p r = preserveCState $ do+    setFillStyle (plot_fillbetween_style_ p)+    fillPath (rectPath r)++plotAllPointsFillBetween :: PlotFillBetween x y -> ([x],[y])+plotAllPointsFillBetween p = ( [ x | (x,(_,_)) <- pts ]+                             , concat [ [y1,y2] | (_,(y1,y2)) <- pts ] )+  where+    pts = plot_fillbetween_values_ p+++defaultPlotFillBetween :: PlotFillBetween x y+defaultPlotFillBetween = PlotFillBetween {+    plot_fillbetween_title_  = "",+    plot_fillbetween_style_  = solidFillStyle (opaque $ sRGB 0.5 0.5 1.0),+    plot_fillbetween_values_ = []+}++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.++$( deriveAccessors ''PlotFillBetween )

@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.Hidden+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Plots that don't show, but occupy space so as to effect axis+-- scaling+--+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.Hidden(+    PlotHidden(..),+) where++import Data.Accessor.Template+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Plot.Types++-- | Value defining some hidden x and y values. The values don't+--   get displayed, but still affect axis scaling.+data PlotHidden x y = PlotHidden {+    plot_hidden_x_values_ :: [x],+    plot_hidden_y_values_ :: [y]+}++instance ToPlot PlotHidden where+    toPlot ph = Plot {+        plot_render_     = \_ -> return (),+        plot_legend_     = [],+        plot_all_points_ = (plot_hidden_x_values_ ph, plot_hidden_y_values_ ph)+    }++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.++$( deriveAccessors ''PlotHidden )+

@@ -0,0 +1,109 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.Lines+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Line plots+--+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.Lines(+    PlotLines(..),+    defaultPlotLines,+    defaultPlotLineStyle,+    hlinePlot,+    vlinePlot,++    plot_lines_title,+    plot_lines_style,+    plot_lines_values,+    plot_lines_limit_values,+) where++import Data.Accessor.Template+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Plot.Types+import Data.Colour (opaque)+import Data.Colour.Names (black, blue)++-- | 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,++    -- | The lines to be plotted+    plot_lines_values_       :: [[(x,y)]],++    -- | Additional lines to be plotted, specified using+    -- the Limit type to allow referencing the edges of+    -- the plot area.+    plot_lines_limit_values_ :: [[(Limit x, Limit y)]]+}++instance ToPlot PlotLines where+    toPlot p = Plot {+        plot_render_     = renderPlotLines p,+        plot_legend_     = [(plot_lines_title_ p, renderPlotLegendLines p)],+        plot_all_points_ = ( map fst pts ++ xs, map snd pts ++ ys )+    }+      where+        pts = concat (plot_lines_values_ p)+        xs = [ x | (LValue x,_) <- concat (plot_lines_limit_values_ p)]+        ys = [ y | (_,LValue y) <- concat (plot_lines_limit_values_ p)]++renderPlotLines :: PlotLines x y -> PointMapFn x y -> CRender ()+renderPlotLines p pmap = preserveCState $ do+    setLineStyle (plot_lines_style_ p)+    mapM_ (drawLines (mapXY pmap)) (plot_lines_values_ p)+    mapM_ (drawLines pmap) (plot_lines_limit_values_ p)+  where+    drawLines mapfn pts = strokePath (map mapfn pts)++renderPlotLegendLines :: PlotLines x y -> Rect -> CRender ()+renderPlotLegendLines p r@(Rect p1 p2) = preserveCState $ do+    setLineStyle (plot_lines_style_ p)+    let y = (p_y p1 + p_y p2) / 2+    strokePath [Point (p_x p1) y, Point (p_x p2) y]++defaultPlotLineStyle :: CairoLineStyle+defaultPlotLineStyle = (solidLine 1 $ opaque blue){+     line_cap_  = C.LineCapRound,+     line_join_ = C.LineJoinRound+ }++defaultPlotLines :: PlotLines x y+defaultPlotLines = PlotLines {+    plot_lines_title_        = "",+    plot_lines_style_        = defaultPlotLineStyle,+    plot_lines_values_       = [],+    plot_lines_limit_values_ = []+}++-- | Helper function to plot a single horizontal line.+hlinePlot :: String -> CairoLineStyle -> b -> Plot a b+hlinePlot t ls v = toPlot defaultPlotLines {+    plot_lines_title_        = t,+    plot_lines_style_        = ls,+    plot_lines_limit_values_ = [[(LMin, LValue v),(LMax, LValue v)]]+    }++-- | Helper function to plot a single vertical line.+vlinePlot :: String -> CairoLineStyle -> a -> Plot a b+vlinePlot t ls v = toPlot defaultPlotLines {+    plot_lines_title_        = t,+    plot_lines_style_        = ls,+    plot_lines_limit_values_ = [[(LValue v,LMin),(LValue v,LMax)]]+    }++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.+$( deriveAccessors ''PlotLines )++++

@@ -0,0 +1,224 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.Rendering.Chart.Plot.Pie
+-- Copyright   :  (c) Tim Docker 2008
+-- License     :  BSD-style (see chart/COPYRIGHT)
+--
+-- A  basic pie chart.
+--
+-- Pie charts are handled different to other plots, in that they
+-- have their own layout, and can't be composed with other plots. A
+-- pie chart is rendered with code in the following form:
+--
+-- @
+-- values :: [PieItem]
+-- values = [...]
+-- layout :: PieLayout
+-- layout = pie_plot ^: pie_data ^= values
+--        $ defaultPieLayout
+-- renderable = toRenderable layout
+-- @
+
+{-# OPTIONS_GHC -XTemplateHaskell #-}
+
+module Graphics.Rendering.Chart.Plot.Pie(
+    PieLayout(..),
+    PieChart(..),
+    PieItem(..),
+    defaultPieLayout,
+    defaultPieChart,
+    defaultPieItem,
+
+    pie_title,
+    pie_title_style,
+    pie_plot,
+    pie_background,
+    pie_margin,
+    pie_data,
+    pie_colors,
+    pie_label_style,
+    pie_label_line_style,
+    pie_start_angle,
+    pitem_label,
+    pitem_offset,
+    pitem_value,
+
+) where
+-- original code thanks to Neal Alexander
+
+import qualified Graphics.Rendering.Cairo as C
+
+import Data.List
+import Data.Bits
+import Data.Accessor.Template
+import Data.Colour
+import Data.Colour.Names (black, white)
+import Control.Monad
+
+import Graphics.Rendering.Chart.Types
+import Graphics.Rendering.Chart.Legend
+import Graphics.Rendering.Chart.Renderable
+import Graphics.Rendering.Chart.Grid
+import Graphics.Rendering.Chart.Plot.Types
+
+data PieLayout = PieLayout {
+   pie_title_       :: String,
+   pie_title_style_ :: CairoFontStyle,
+   pie_plot_        :: PieChart,
+   pie_background_  :: CairoFillStyle,
+   pie_margin_      :: Double
+}
+
+data PieChart = PieChart {
+   pie_data_             :: [PieItem],
+   pie_colors_           :: [AlphaColour Double],
+   pie_label_style_      :: CairoFontStyle,
+   pie_label_line_style_ :: CairoLineStyle, 
+   pie_start_angle_      :: Double
+
+}
+
+data PieItem = PieItem {
+   pitem_label_  :: String,
+   pitem_offset_ :: Double,
+   pitem_value_  :: Double
+}
+
+defaultPieChart :: PieChart
+defaultPieChart = PieChart {
+    pie_data_             = [], 
+    pie_colors_           = defaultColorSeq,
+    pie_label_style_      = defaultFontStyle,
+    pie_label_line_style_ = solidLine 1 $ opaque black,
+    pie_start_angle_      = 0
+}
+
+defaultPieItem :: PieItem
+defaultPieItem = PieItem "" 0 0
+
+defaultPieLayout :: PieLayout
+defaultPieLayout = PieLayout {
+    pie_background_  = solidFillStyle $ opaque white,
+    pie_title_       = "",
+    pie_title_style_ = defaultFontStyle{ font_size_   = 15
+                                       , font_weight_ = C.FontWeightBold },
+    pie_plot_        = defaultPieChart,
+    pie_margin_      = 10
+}
+
+instance ToRenderable PieLayout where
+    toRenderable p = fillBackground (pie_background_ p) (
+       gridToRenderable $ aboveN
+         [ tval $ addMargins (lm/2,0,0,0) (setPickFn nullPickFn title)
+         , weights (1,1) $ tval $ addMargins (lm,lm,lm,lm)
+                                             (toRenderable $ pie_plot_ p)
+         ] )
+      where
+        title = label (pie_title_style_ p) HTA_Centre VTA_Top (pie_title_ p)
+        lm    = pie_margin_ p
+
+instance ToRenderable PieChart where
+    toRenderable p = Renderable {
+      minsize = minsizePie p,
+      render  = renderPie p
+    }
+
+extraSpace p = do
+    textSizes <- mapM textSize (map pitem_label_ (pie_data_ p))
+    let maxw  = foldr (max.fst) 0 textSizes
+    let maxh  = foldr (max.snd) 0 textSizes
+    let maxo  = foldr (max.pitem_offset_) 0 (pie_data_ p)
+    let extra = label_rgap + label_rlength + maxo
+    return (extra + maxw, extra + maxh )
+
+minsizePie p = do
+    (extraw,extrah) <- extraSpace p
+    return (extraw * 2, extrah * 2)
+
+renderPie p (w,h) = do
+    (extraw,extrah) <- extraSpace p
+    let (w,h)  = (p_x p2 - p_x p1, p_y p2 - p_y p1)
+    let center = Point (p_x p1 + w/2)  (p_y p1 + h/2)
+    let radius = (min (w - 2*extraw) (h - 2*extrah)) / 2
+
+    foldM_ (paint center radius) (pie_start_angle_ p)
+           (zip (pie_colors_ p) content)
+    return nullPickFn
+ 
+    where
+        p1 = Point 0 0 
+        p2 = Point w h 
+        content = let total = sum (map pitem_value_ (pie_data_ p))
+                  in [ pi{pitem_value_=pitem_value_ pi/total}
+                     | pi <- pie_data_ p ]
+
+        paint :: Point -> Double -> Double -> (AlphaColour Double, PieItem)
+                 -> CRender Double
+        paint center radius a1 (color,pitem) = do
+            let ax     = 360.0 * (pitem_value_ pitem)
+            let a2     = a1 + (ax / 2)
+            let a3     = a1 + ax
+            let offset = pitem_offset_ pitem
+
+            pieSlice (ray a2 offset) a1 a3 color
+            pieLabel (pitem_label_ pitem) a2 offset
+
+            return a3
+
+            where
+                pieLabel :: String -> Double -> Double -> CRender ()
+                pieLabel name angle offset = do
+                    setFontStyle (pie_label_style_ p)
+                    setLineStyle (pie_label_line_style_ p)
+
+                    moveTo (ray angle (radius + label_rgap+offset))
+                    let p1 = ray angle (radius+label_rgap+label_rlength+offset)
+                    lineTo p1
+                    (tw,th) <- textSize name
+                    let (offset,anchor) = if angle < 90 || angle > 270 
+                                          then ((0+),HTA_Left)
+                                          else ((0-),HTA_Right)
+                    c $ C.relLineTo (offset (tw + label_rgap)) 0
+                    c $ C.stroke
+
+                    let p2 = p1 `pvadd` (Vector (offset label_rgap) 0)
+                    drawText anchor VTA_Bottom p2 name
+
+                pieSlice :: Point -> Double -> Double -> AlphaColour Double
+                            -> CRender ()
+                pieSlice (Point x y) a1 a2 color = c $ do
+                    C.newPath
+                    C.arc x y radius (radian a1) (radian a2)
+                    C.lineTo x y
+                    C.lineTo x y
+                    C.closePath
+
+                    setSourceColor color
+                    C.fillPreserve
+                    C.setSourceRGBA 1 1 1 0.1
+
+                    C.stroke
+
+                ray :: Double -> Double -> Point
+                ray angle r = Point x' y'
+                  where
+                    x'   = x + (cos' * x'')
+                    y'   = y + (sin' * x'')
+                    cos' = (cos . radian) angle
+                    sin' = (sin . radian) angle
+                    x''  = ((x + r) - x)
+                    x    = p_x center
+                    y    = p_y center
+
+                radian = (*(pi / 180.0))
+
+
+label_rgap = 5
+label_rlength = 15
+
+----------------------------------------------------------------------
+-- Template haskell to derive an instance of Data.Accessor.Accessor
+-- for each field.
+$( deriveAccessors ''PieLayout )
+$( deriveAccessors ''PieChart )
+$( deriveAccessors ''PieItem )

@@ -0,0 +1,75 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.Points+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Functions to plot sets of points, marked in various styles.++{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.Points(+    PlotPoints(..),+    defaultPlotPoints,++    -- * Accessors+    -- | These accessors are generated by template haskell++    plot_points_title,+    plot_points_style,+    plot_points_values,+) where+    +import Data.Accessor.Template+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Plot.Types+import Data.Colour (opaque)+import Data.Colour.Names (black, blue)++-- | 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)]+}++instance ToPlot PlotPoints where+    toPlot p = Plot {+        plot_render_     = renderPlotPoints p,+        plot_legend_     = [(plot_points_title_ p, renderPlotLegendPoints p)],+        plot_all_points_ = (map fst pts, map snd pts)+    }+      where+        pts = plot_points_values_ p++renderPlotPoints :: PlotPoints x y -> PointMapFn x y -> CRender ()+renderPlotPoints p pmap = preserveCState $ do+    mapM_ (drawPoint.pmap') (plot_points_values_ p)+  where+    pmap' = mapXY pmap+    (CairoPointStyle drawPoint) = (plot_points_style_ p)++renderPlotLegendPoints :: PlotPoints x y -> Rect -> CRender ()+renderPlotLegendPoints p r@(Rect p1 p2) = preserveCState $ do+    drawPoint (Point (p_x p1)              ((p_y p1 + p_y p2)/2))+    drawPoint (Point ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2))+    drawPoint (Point (p_x p2)              ((p_y p1 + p_y p2)/2))++  where+    (CairoPointStyle drawPoint) = (plot_points_style_ p)++defaultPlotPoints :: PlotPoints x y+defaultPlotPoints = PlotPoints {+    plot_points_title_  = "",+    plot_points_style_  = defaultPointStyle,+    plot_points_values_ = []+}++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.++$( deriveAccessors ''PlotPoints )

@@ -0,0 +1,83 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot.Types+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- Datatypes and functions common to the implementation of the various+-- plot types.+--+{-# OPTIONS_GHC -XTemplateHaskell #-}++module Graphics.Rendering.Chart.Plot.Types(+    Plot(..),+    joinPlot,+    ToPlot(..),++    mapXY,++    plot_render,+    plot_legend,+    plot_all_points,++    ) where++import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Control.Monad+import Data.Accessor.Template+import Data.Colour+import Data.Colour.Names++-- | Interface to control plotting on a 2D area.+data Plot x y = Plot {++    -- | Given the mapping between model space coordinates and device+    --   coordinates, render this plot into a chart.+    plot_render_     :: PointMapFn x y -> 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.+    plot_all_points_ :: ([x],[y])+}++-- | A type class abstracting the conversion of a value to a Plot.+class ToPlot a where+   toPlot :: a x y -> Plot x y++-- | Join any two plots together (they will share a legend).+joinPlot :: Plot x y -> Plot x y -> Plot x y+joinPlot Plot{ plot_render_     = renderP+             , plot_legend_     = legendP+             , plot_all_points_ = (xsP,ysP) }+         Plot{ plot_render_     = renderQ+             , plot_legend_     = legendQ+             , plot_all_points_ = (xsQ,ysQ) }++       = Plot{ plot_render_     = \a-> renderP a >> renderQ a+             , plot_legend_     = legendP ++ legendQ+             , plot_all_points_ = ( xsP++xsQ, ysP++ysQ )+             }+++----------------------------------------------------------------------++mapXY :: PointMapFn x y -> ((x,y) -> Point)+mapXY f (x,y) = f (LValue x, LValue y)++----------------------------------------------------------------------++++----------------------------------------------------------------------++----------------------------------------------------------------------+-- Template haskell to derive an instance of Data.Accessor.Accessor+-- for each field.+$( deriveAccessors ''Plot )

@@ -41,6 +41,7 @@ ) where  import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.Matrix as Matrix import Control.Monad import Data.Accessor import Data.List ( nub, transpose, sort )@@ -113,17 +114,11 @@         preserveCState $ do             c $ C.translate l t             pickf <- render rd (w-l-r,h-t-b)-            mtx   <- c $ C.getMatrix-            return (mkpickf pickf (w,h) mtx)--    mkpickf pickf (w,h) mtx pt | within pt' rect = pickf pt'-                               | otherwise       = Nothing-      where-        pt'  = transform mtx pt-        rect = (Rect (Point 0 0) (Point w h))+            return (mkpickf pickf (t,b,l,r) (w,h)) -transform :: C.Matrix -> Point -> Point-transform = undefined+    mkpickf pickf (t,b,l,r) (w,h) (Point x y)+        | x >= l && x <= w-r && y >= t && t <= h-b = pickf (Point (x-l) (y-t))+        | otherwise                                = Nothing  -- | Overlay a renderable over a solid background fill. fillBackground :: CairoFillStyle -> Renderable a -> Renderable a@@ -138,11 +133,12 @@  -- | Output the given renderable to a PNG file of the specifed size --   (in pixels), to the specified file.-renderableToPNGFile :: Renderable a -> Int -> Int -> FilePath -> IO ()+renderableToPNGFile :: Renderable a -> Int -> Int -> FilePath -> IO (PickFn a) renderableToPNGFile chart width height path =      C.withImageSurface C.FormatARGB32 width height $ \result -> do-    C.renderWith result $ runCRender rfn bitmapEnv+    pick <- C.renderWith result $ runCRender rfn bitmapEnv     C.surfaceWriteToPNG result path+    return pick   where     rfn = do 	render chart (fromIntegral width, fromIntegral height)@@ -194,13 +190,14 @@ -- Labels  -- | Construct a renderable from a text string, aligned with the axes.-label :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> String -> Renderable a+label :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> String+         -> Renderable String label fs hta vta = rlabel fs hta vta 0  -- | Construct a renderable from a text string, rotated wrt to axes. The angle --   of rotation is in degrees. rlabel :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> Double -> String-          -> Renderable a+          -> Renderable String rlabel fs hta vta rot s = Renderable { minsize = mf, render = rf }   where     mf = preserveCState $ do@@ -216,7 +213,7 @@        c $ C.rotate rot'        c $ C.moveTo (-w/2) (h/2)        c $ C.showText s-       return nullPickFn+       return (\_-> Just s)  -- PickFn String     xadj (w,h) HTA_Left   x1 x2 =  x1 +(w*acr+h*asr)/2     xadj (w,h) HTA_Centre x1 x2 = (x1 + x2)/2     xadj (w,h) HTA_Right  x1 x2 =  x2 -(w*acr+h*asr)/2

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module      :  Graphics.Rendering.Chart.Simple@@ -32,7 +33,10 @@ -- > plotPS "foo.ps" [0,0.1..10] (sin . exp) "- " (sin . exp) "o-" ----------------------------------------------------------------------------- module Graphics.Rendering.Chart.Simple( plot, PlotKind(..), xcoords,-                                        plotWindow, plotPDF, plotPS,+#if HAVE_GTK+                                        plotWindow,+#endif+                                        plotPDF, plotPS,                                         plotLayout, plotPNG, Layout1DDD                                       ) where @@ -41,7 +45,9 @@ import Data.Colour.Names  import Graphics.Rendering.Chart+#if HAVE_GTK import Graphics.Rendering.Chart.Gtk+#endif  styleColor :: Int -> AlphaColour Double styleColor ind = colorSequence !! ind@@ -223,6 +229,7 @@ instance PlotType Layout1DDD where     pl args = uplot (reverse args) +#if HAVE_GTK -- | Display a plot on the screen.  plotWindow :: PlotWindowType a => a@@ -235,6 +242,7 @@     plw args = do         renderableToWindow (toRenderable $ uplot (reverse args)) 640 480         return undefined+#endif  -- | Save a plot as a PDF file. 

@@ -86,7 +86,9 @@     VTextAnchor(..),     drawText,     drawTextR,+    drawTextsR,     textSize,+    textDrawRect,      CRender(..),     CEnv(..),@@ -116,6 +118,7 @@ import Data.Colour import Data.Colour.SRGB import Data.Colour.Names+import Data.List (unfoldr)  -- | A point in two dimensions. data Point = Point {@@ -338,6 +341,28 @@ data HTextAnchor = HTA_Left | HTA_Centre | HTA_Right data VTextAnchor = VTA_Top | VTA_Centre | VTA_Bottom | VTA_BaseLine +-- | Recturn the bounding rectangle for a text string positioned+--   where it would be drawn by drawText+textDrawRect :: HTextAnchor -> VTextAnchor -> Point -> String -> CRender Rect+textDrawRect hta vta (Point x y) s = preserveCState $ textSize s >>= rect+    where+      rect (w,h) = c $ do te <- C.textExtents s+                          fe <- C.fontExtents+                          let lx = xadj hta (C.textExtentsWidth te)+                          let ly = yadj vta te fe+                          let (x',y') = (x + lx, y + ly)+                          let p1 = Point x' y'+                          let p2 = Point (x' + w) (y' + h)+                          return $ Rect p1 p2++      xadj HTA_Left   w = 0+      xadj HTA_Centre w = (-w/2)+      xadj HTA_Right  w = (-w)+      yadj VTA_Top      te fe = C.fontExtentsAscent fe+      yadj VTA_Centre   te fe = - (C.textExtentsYbearing te) / 2+      yadj VTA_BaseLine te fe = 0+      yadj VTA_Bottom   te fe = -(C.fontExtentsDescent fe)+ -- | Function to draw a textual label anchored by one of its corners --   or edges. drawText :: HTextAnchor -> VTextAnchor -> Point -> String -> CRender ()@@ -365,6 +390,42 @@       yadj VTA_Centre   te fe = - (C.textExtentsYbearing te) / 2       yadj VTA_BaseLine te fe = 0       yadj VTA_Bottom   te fe = -(C.fontExtentsDescent fe)++-- | Function to draw a multi-line textual label anchored by one of its corners+--   or edges, with rotation. Rotation angle is given in degrees,+--   rotation is performed around anchor point.+drawTextsR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> CRender ()+drawTextsR hta vta angle (Point x y) s = preserveCState $ drawAll+    where+      ss   = lines s+      num  = length ss+      drawAll =  c $ do tes <- mapM C.textExtents ss+                        fe  <- C.fontExtents+                        let widths = map C.textExtentsWidth tes+                            maxw   = maximum widths+                            maxh   = maximum (map C.textExtentsYbearing tes)+                            gap    = maxh / 2 -- half-line spacing+                            totalHeight = fromIntegral num*maxh ++                                          (fromIntegral num-1)*gap+                            ys = take num (unfoldr (\y-> Just (y, y-gap-maxh))+                                                   (yinit vta fe totalHeight))+                            xs = map (xadj hta) widths+                        C.translate x y+                        C.rotate theta+                        sequence_ (zipWith3 draw xs ys ss)++      draw lx ly s =  do C.moveTo lx ly+                         C.showText s+      theta = angle*pi/180.0++      xadj HTA_Left   w = 0+      xadj HTA_Centre w = (-w/2)+      xadj HTA_Right  w = (-w)++      yinit VTA_Top      fe height = C.fontExtentsAscent fe+      yinit VTA_BaseLine fe height = 0+      yinit VTA_Centre   fe height = height / 2 + C.fontExtentsAscent fe+      yinit VTA_Bottom   fe height = height + C.fontExtentsAscent fe   -- | Execute a rendering action in a saved context (ie bracketed

@@ -0,0 +1,219 @@+module ExampleStocks where+import Data.Time.Calendar+import Data.Time.LocalTime++mkDate :: Integer -> LocalTime+mkDate jday =+  LocalTime (ModifiedJulianDay jday) midnight++-- Price data imported from Yahoo: low, open, close, high++pricesAAPL :: [(LocalTime,(Double,Double,Double,Double))]+pricesMSFT :: [(LocalTime,(Double,Double,Double,Double))]+pricesARMH :: [(LocalTime,(Double,Double,Double,Double))]++pricesAAPL = +    [ (mkDate 55105,(180.7,185.35,180.86,186.22))+    , (mkDate 55104,(182.61,186.13,185.35,186.45))+    , (mkDate 55103,(184.31,186.73,185.38,187.4))+    , (mkDate 55102,(183.33,183.87,186.15,186.68))+    , (mkDate 55099,(181.44,182.01,182.37,185.5))+    , (mkDate 55098,(182.77,187.2,183.82,187.7))+    , (mkDate 55097,(185.03,185.4,185.5,188.9))+    , (mkDate 55096,(182.85,185.19,184.48,185.38))+    , (mkDate 55095,(181.62,184.29,184.02,185.16))+    , (mkDate 55092,(184.76,185.83,185.02,186.55))+    , (mkDate 55091,(181.97,181.98,184.55,186.79))+    , (mkDate 55090,(177.88,177.99,181.87,182.75))+    , (mkDate 55089,(173.59,174.04,175.16,175.65))+    , (mkDate 55088,(170.25,170.83,173.72,173.9))+    , (mkDate 55085,(170.87,172.91,172.16,173.18))+    , (mkDate 55084,(170.81,172.06,172.56,173.25))+    , (mkDate 55083,(169.7,172.78,171.14,174.47))+    , (mkDate 55082,(172.0,172.98,172.93,173.14))+    , (mkDate 55078,(167.09,167.28,170.31,170.7))+    , (mkDate 55077,(165.0,166.44,166.55,167.1))+    , (mkDate 55076,(164.11,164.62,165.18,167.61))+    , (mkDate 55075,(164.94,167.99,165.3,170.0))+    , (mkDate 55074,(166.5,168.16,168.21,168.85))+    , (mkDate 55071,(168.53,172.27,170.05,172.49))+    , (mkDate 55070,(164.83,168.75,169.45,169.57))+    , (mkDate 55069,(166.76,168.92,167.41,169.55))+    , (mkDate 55068,(169.13,169.46,169.4,170.94))+    , (mkDate 55067,(168.27,170.12,169.06,170.71))+    , (mkDate 55064,(166.8,167.65,169.22,169.37))+    , (mkDate 55063,(164.61,164.98,166.33,166.72))+    , (mkDate 55062,(162.45,162.75,164.6,165.3))+    , (mkDate 55061,(161.41,161.63,164.0,164.24))+    , (mkDate 55060,(159.42,163.55,159.59,163.59))+    , (mkDate 55057,(165.53,167.94,166.78,168.23))+    , (mkDate 55056,(166.5,166.65,168.42,168.67))+    , (mkDate 55055,(162.46,162.55,165.31,166.71))+    , (mkDate 55054,(161.88,163.69,162.83,164.38))+    , (mkDate 55053,(163.66,165.66,164.72,166.6))+    , (mkDate 55050,(164.8,165.49,165.51,166.6))+    , (mkDate 55049,(163.09,165.58,163.91,166.51))+    , (mkDate 55048,(164.21,165.75,165.11,167.39))+    , (mkDate 55047,(164.21,164.93,165.55,165.57))+    , (mkDate 55046,(164.87,165.21,166.43,166.64))+    , (mkDate 55043,(162.91,162.99,163.39,165.0))+    , (mkDate 55042,(161.5,161.7,162.79,164.72))+    , (mkDate 55041,(158.25,158.9,160.03,160.45))+    , (mkDate 55040,(157.6,158.88,160.0,160.1))+    , (mkDate 55039,(157.26,160.17,160.1,160.88))+    , (mkDate 55036,(156.5,156.95,159.99,160.0))+    , (mkDate 55035,(155.56,156.63,157.82,158.44))+    , (mkDate 55034,(156.11,157.79,156.74,158.73))+    , (mkDate 55033,(149.75,153.29,151.51,153.43))+    , (mkDate 55032,(150.89,153.27,152.91,155.04))+    , (mkDate 55029,(148.63,149.08,151.75,152.02))+    , (mkDate 55028,(145.57,145.76,147.52,148.02))+    , (mkDate 55027,(144.32,145.04,146.88,147.0))+    , (mkDate 55026,(141.16,142.03,142.27,143.18))+    , (mkDate 55025,(137.53,139.54,142.34,142.34))+    , (mkDate 55022,(136.32,136.34,138.52,138.97))+    , (mkDate 55021,(135.93,137.76,136.36,137.99))+    , (mkDate 55020,(134.42,135.92,137.22,138.04))+    , (mkDate 55019,(135.18,138.48,135.4,139.68))+    , (mkDate 55018,(136.25,138.7,138.61,138.99))+    , (mkDate 55014,(139.79,141.25,140.02,142.83))+    , (mkDate 55013,(142.52,143.5,142.83,144.66))+    ]++pricesMSFT = +    [ (mkDate 55105,(24.8,25.41,24.88,25.47))+    , (mkDate 55104,(25.38,25.76,25.72,25.99))+    , (mkDate 55103,(25.69,25.91,25.75,25.96))+    , (mkDate 55102,(25.6,25.6,25.83,26.16))+    , (mkDate 55099,(25.52,25.69,25.55,25.82))+    , (mkDate 55098,(25.66,25.92,25.94,26.11))+    , (mkDate 55097,(25.64,25.92,25.71,26.25))+    , (mkDate 55096,(25.29,25.4,25.77,25.82))+    , (mkDate 55095,(25.1,25.11,25.3,25.37))+    , (mkDate 55092,(25.1,25.46,25.26,25.48))+    , (mkDate 55091,(25.06,25.06,25.3,25.38))+    , (mkDate 55090,(24.95,25.25,25.2,25.35))+    , (mkDate 55089,(24.86,24.97,25.2,25.27))+    , (mkDate 55088,(24.64,24.65,25.0,25.09))+    , (mkDate 55085,(24.81,24.93,24.86,25.17))+    , (mkDate 55084,(24.65,24.8,25.0,25.05))+    , (mkDate 55083,(24.67,24.74,24.78,24.95))+    , (mkDate 55082,(24.41,24.62,24.82,24.84))+    , (mkDate 55078,(24.08,24.09,24.62,24.8))+    , (mkDate 55077,(23.76,23.91,24.11,24.14))+    , (mkDate 55076,(23.78,23.82,23.86,24.14))+    , (mkDate 55075,(23.9,24.35,24.0,24.74))+    , (mkDate 55074,(24.29,24.57,24.65,24.85))+    , (mkDate 55071,(24.61,25.07,24.68,25.49))+    , (mkDate 55070,(24.3,24.41,24.69,24.78))+    , (mkDate 55069,(24.42,24.59,24.55,24.75))+    , (mkDate 55068,(24.46,24.6,24.64,24.82))+    , (mkDate 55067,(24.28,24.41,24.64,24.73))+    , (mkDate 55064,(23.77,23.93,24.41,24.42))+    , (mkDate 55063,(23.54,23.6,23.67,23.87))+    , (mkDate 55062,(23.25,23.25,23.65,23.72))+    , (mkDate 55061,(23.27,23.29,23.58,23.65))+    , (mkDate 55060,(23.23,23.32,23.25,23.6))+    , (mkDate 55057,(23.51,23.62,23.69,23.8))+    , (mkDate 55056,(23.4,23.63,23.62,23.85))+    , (mkDate 55055,(23.03,23.13,23.53,23.9))+    , (mkDate 55054,(23.05,23.32,23.13,23.4))+    , (mkDate 55053,(23.3,23.46,23.42,23.55))+    , (mkDate 55050,(23.5,23.75,23.56,23.82))+    , (mkDate 55049,(23.27,23.93,23.46,23.98))+    , (mkDate 55048,(23.79,23.84,23.81,24.25))+    , (mkDate 55047,(23.53,23.68,23.77,23.79))+    , (mkDate 55046,(23.5,23.82,23.83,23.86))+    , (mkDate 55043,(23.5,23.77,23.52,24.07))+    , (mkDate 55042,(23.71,24.2,23.81,24.43))+    , (mkDate 55041,(23.34,23.73,23.8,23.91))+    , (mkDate 55040,(22.9,22.99,23.47,23.55))+    , (mkDate 55039,(22.9,23.44,23.11,23.45))+    , (mkDate 55036,(22.81,23.61,23.45,23.89))+    , (mkDate 55035,(24.84,24.93,25.56,25.72))+    , (mkDate 55034,(24.51,24.7,24.8,24.9))+    , (mkDate 55033,(24.37,24.69,24.83,24.83))+    , (mkDate 55032,(24.15,24.44,24.53,24.53))+    , (mkDate 55029,(24.1,24.4,24.29,24.45))+    , (mkDate 55028,(23.86,23.93,24.44,24.44))+    , (mkDate 55027,(23.56,23.75,24.12,24.12))+    , (mkDate 55026,(22.86,23.2,23.11,23.22))+    , (mkDate 55025,(22.14,22.42,23.23,23.29))+    , (mkDate 55022,(22.15,22.19,22.39,22.54))+    , (mkDate 55021,(22.37,22.65,22.44,22.81))+    , (mkDate 55020,(22.0,22.31,22.56,22.69))+    , (mkDate 55019,(22.46,23.08,22.53,23.14))+    , (mkDate 55018,(22.87,23.21,23.2,23.28))+    , (mkDate 55014,(23.21,23.76,23.37,24.04))+    , (mkDate 55013,(23.96,24.05,24.04,24.3))+    ]++pricesARMH = +    [ (mkDate 55105,(6.65,6.83,6.65,6.86))+    , (mkDate 55104,(6.87,7.0,7.0,7.02))+    , (mkDate 55103,(6.88,6.92,6.95,6.97))+    , (mkDate 55102,(6.62,6.63,6.81,6.82))+    , (mkDate 55099,(6.69,6.88,6.72,6.88))+    , (mkDate 55098,(6.55,6.69,6.64,6.88))+    , (mkDate 55097,(6.8,6.87,6.8,6.94))+    , (mkDate 55096,(6.67,6.68,6.74,6.78))+    , (mkDate 55095,(6.62,6.67,6.7,6.77))+    , (mkDate 55092,(6.63,6.71,6.7,6.76))+    , (mkDate 55091,(6.64,6.7,6.67,6.76))+    , (mkDate 55090,(6.76,6.84,6.77,6.85))+    , (mkDate 55089,(6.69,6.73,6.84,6.9))+    , (mkDate 55088,(6.73,6.74,6.8,6.81))+    , (mkDate 55085,(6.84,7.05,6.87,7.07))+    , (mkDate 55084,(6.65,6.7,6.94,6.97))+    , (mkDate 55083,(6.65,6.71,6.7,6.75))+    , (mkDate 55082,(6.56,6.58,6.65,6.68))+    , (mkDate 55078,(6.16,6.18,6.39,6.41))+    , (mkDate 55077,(6.11,6.19,6.21,6.24))+    , (mkDate 55076,(6.03,6.07,6.09,6.14))+    , (mkDate 55075,(6.14,6.22,6.24,6.31))+    , (mkDate 55074,(6.3,6.45,6.35,6.45))+    , (mkDate 55071,(6.4,6.5,6.47,6.56))+    , (mkDate 55070,(6.13,6.18,6.35,6.39))+    , (mkDate 55069,(6.1,6.12,6.16,6.2))+    , (mkDate 55068,(6.14,6.3,6.17,6.3))+    , (mkDate 55067,(6.19,6.29,6.21,6.34))+    , (mkDate 55064,(6.25,6.32,6.3,6.38))+    , (mkDate 55063,(6.18,6.2,6.25,6.27))+    , (mkDate 55062,(6.09,6.11,6.19,6.22))+    , (mkDate 55061,(6.14,6.14,6.23,6.28))+    , (mkDate 55060,(5.91,6.02,5.98,6.04))+    , (mkDate 55057,(6.04,6.15,6.2,6.21))+    , (mkDate 55056,(6.1,6.18,6.22,6.26))+    , (mkDate 55055,(6.07,6.07,6.22,6.3))+    , (mkDate 55054,(6.09,6.23,6.14,6.23))+    , (mkDate 55053,(6.19,6.39,6.23,6.4))+    , (mkDate 55050,(6.25,6.31,6.32,6.41))+    , (mkDate 55049,(6.2,6.42,6.24,6.42))+    , (mkDate 55048,(6.4,6.55,6.46,6.55))+    , (mkDate 55047,(6.5,6.52,6.67,6.7))+    , (mkDate 55046,(6.5,6.51,6.58,6.6))+    , (mkDate 55043,(6.3,6.34,6.39,6.43))+    , (mkDate 55042,(6.42,6.47,6.46,6.64))+    , (mkDate 55041,(6.14,6.37,6.22,6.49))+    , (mkDate 55040,(6.28,6.32,6.52,6.56))+    , (mkDate 55039,(6.41,6.47,6.49,6.63))+    , (mkDate 55036,(6.27,6.36,6.44,6.44))+    , (mkDate 55035,(6.47,6.48,6.52,6.55))+    , (mkDate 55034,(6.38,6.41,6.47,6.51))+    , (mkDate 55033,(6.27,6.45,6.41,6.46))+    , (mkDate 55032,(6.32,6.44,6.45,6.48))+    , (mkDate 55029,(6.23,6.25,6.37,6.45))+    , (mkDate 55028,(6.24,6.29,6.35,6.39))+    , (mkDate 55027,(6.37,6.53,6.45,6.6))+    , (mkDate 55026,(6.12,6.13,6.19,6.23))+    , (mkDate 55025,(5.98,6.02,6.12,6.13))+    , (mkDate 55022,(5.93,5.96,6.08,6.12))+    , (mkDate 55021,(5.74,5.8,5.97,6.0))+    , (mkDate 55020,(5.61,5.74,5.69,5.82))+    , (mkDate 55019,(5.68,5.82,5.69,5.84))+    , (mkDate 55018,(5.77,5.84,5.91,5.93))+    , (mkDate 55014,(5.89,6.03,5.94,6.06))+    , (mkDate 55013,(5.93,5.98,5.95,6.03))+    ]++

@@ -297,16 +297,96 @@     (31,03,2007, 28.00, 78.85)     ] +rawHourly = [+    (03,05,2005,00, 16.18, 42.02),+    (03,05,2005,01, 16.25, 42.31),+    (03,05,2005,02, 16.50, 42.95),+    (03,05,2005,03, 16.52, 43.50),+    (03,05,2005,04, 16.84, 44.91),+    (03,05,2005,05, 16.70, 44.55),+    (03,05,2005,06, 16.43, 43.63),+    (03,05,2005,07, 16.29, 43.18),+    (03,05,2005,08, 15.95, 42.40),+    (03,05,2005,09, 15.55, 41.65),+    (03,05,2005,10, 15.71, 42.17),+    (03,05,2005,11, 15.93, 42.37),+    (03,05,2005,12, 16.20, 42.85),+    (03,05,2005,13, 15.88, 42.30),+    (03,05,2005,14, 15.92, 42.53),+    (03,05,2005,15, 16.25, 42.81),+    (03,05,2005,16, 16.20, 42.67),+    (03,05,2005,17, 16.05, 42.35),+    (03,05,2005,18, 16.45, 43.12),+    (03,05,2005,19, 16.85, 43.24),+    (03,05,2005,20, 16.68, 42.57),+    (03,05,2005,21, 16.85, 43.22),+    (03,05,2005,22, 17.17, 43.85),+    (03,05,2005,23, 17.42, 44.15),+    (04,05,2005,00, 17.50, 44.07),+    (04,05,2005,01, 17.37, 43.76),+    (04,05,2005,02, 17.15, 43.21),+    (04,05,2005,03, 17.12, 43.42),+    (04,05,2005,04, 17.15, 43.27),+    (04,05,2005,05, 17.34, 43.30),+    (04,05,2005,06, 17.46, 43.90),+    (04,05,2005,07, 17.71, 44.43),+    (04,05,2005,08, 18.25, 45.45),+    (04,05,2005,09, 18.23, 45.16),+    (04,05,2005,10, 18.26, 45.54),+    (04,05,2005,11, 18.11, 45.06),+    (04,05,2005,12, 17.79, 44.65)+    ]+ prices :: [(LocalTime,Double,Double)] prices = [ (mkDate dd mm yyyy, p1, p2) | (dd,mm,yyyy,p1,p2) <- rawPrices ] -filterPrices t1 t2 = [ v | v@(d,_,_) <- prices, let t = d in t >= t1 && t <= t2]+hourlyPrices :: [(LocalTime,Double,Double)]+hourlyPrices = [ (mkDateTime dd mm yyyy hh 00, p1, p2)+               | (dd,mm,yyyy,hh,p1,p2) <- rawHourly ] -prices1 = filterPrices (mkDate 1 1 2005) (mkDate 31 12 2005)-prices2 = filterPrices (mkDate 1 6 2005) (mkDate 1 9 2005)-prices3 = filterPrices (mkDate 1 1 2006) (mkDate 10 1 2006)-prices4 = filterPrices (mkDate 1 8 2005) (mkDate 31 8 2005)+minutePrices :: [(LocalTime,Double,Double)]+minutePrices = [ (mkDateTime dd mm yyyy 05 hh, p1, p2)+               | (dd,mm,yyyy,hh,p1,p2) <- take 24 rawHourly ]+            ++ [ (mkDateTime dd mm yyyy 05 (hh+24), p1, p2)+               | (dd,mm,yyyy,hh,p1,p2) <- take 24 rawHourly ] -mkDate dd mm yyyy = (LocalTime (fromGregorian (fromIntegral yyyy) mm dd) midnight)+secondPrices :: [(LocalTime,Double,Double)]+secondPrices = [ (mkSeconds ss, p1, p2)+               | (ss,(_,_,_,p1,p2)) <- zip [0..] rawPrices ] +filterPrices prices t1 t2 = [ v | v@(d,_,_) <- prices+                                , let t = d in t >= t1 && t <= t2]++prices1 = filterPrices prices (mkDate 1 1 2005) (mkDate 31 12 2005)+prices2 = filterPrices prices (mkDate 1 6 2005) (mkDate 1 9 2005)+prices3 = filterPrices prices (mkDate 1 1 2006) (mkDate 10 1 2006)+prices4 = filterPrices prices (mkDate 1 8 2005) (mkDate 31 8 2005)+prices5 = filterPrices prices (mkDate 1 6 2005) (mkDate 15 7 2005)+prices6 = filterPrices prices (mkDate 1 6 2005) (mkDate 2  7 2005)+prices7 = filterPrices prices (mkDate 20 6 2005) (mkDate 12 7 2005)+prices8 = filterPrices prices (mkDate 6 6 2005) (mkDate 9  6 2005)+prices9 = filterPrices prices (mkDate 6 6 2005) (mkDate 8  6 2005)+prices10 = hourlyPrices+prices10a = take 31 hourlyPrices+prices10b = take 15 hourlyPrices+prices11 = filterPrices hourlyPrices (mkDateTime 3 5 2005 02 30)+                                     (mkDateTime 4 5 2005 02 30)+prices12 = filterPrices hourlyPrices (mkDateTime 3 5 2005 02 30)+                                     (mkDateTime 3 5 2005 06 30)+prices13  = minutePrices+prices13a = take 24 minutePrices+prices13b = take 16 minutePrices+prices14  = secondPrices+prices14a = take 90 secondPrices+prices14b = take 35 secondPrices+prices14c = take 30 secondPrices+prices14d = take  7 secondPrices++mkDate dd mm yyyy =+    LocalTime (fromGregorian (fromIntegral yyyy) mm dd) midnight+mkDateTime dd mm yyyy hh nn =+    LocalTime (fromGregorian (fromIntegral yyyy) mm dd)+              (dayFractionToTimeOfDay ((hh*60+nn)/1440))+mkSeconds ss = LocalTime (fromGregorian (fromIntegral 2009) 11 23)+                         (dayFractionToTimeOfDay (((14*60+32)*60+ss)/(1440*60))) 

@@ -31,10 +31,10 @@               $ plot_points_title ^="am points"               $ defaultPlotPoints -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile (chart 0.25) 320 240 "test1_small.png" main1 ["big"]    = renderableToPNGFile (chart 0.25) 800 600 "test1_big.png"-main1 _          = renderableToWindow  (chart 1.00) 640 480+main1 _          = renderableToWindow  (chart 1.00) 640 480 >> return undefined  main = getArgs >>= main1 

@@ -40,9 +40,9 @@               $ line_color ^= opaque blue               $ defaultPlotLines ^. plot_lines_style -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile (chart 0.25) 320 240 "test14_small.png" main1 ["big"]    = renderableToPNGFile (chart 0.25) 800 600 "test14_big.png"-main1 _          = renderableToWindow  (chart 1.00) 640 480+main1 _          = renderableToWindow  (chart 1.00) 640 480 >> return undefined  main = getArgs >>= main1

@@ -0,0 +1,50 @@+module Test14a where ++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Gtk+import Graphics.Rendering.Chart.Plot+import Data.Colour+import Data.Colour.Names+import Data.Accessor+import System.Random+import System.Environment(getArgs)+import Prices(prices1)++-- demonstrate AreaSpots4D++chart :: Double -> Renderable ()+chart lwidth = toRenderable layout+  where+    layout = layout1_title ^="Price History"+           $ layout1_background ^= solidFillStyle (opaque white)+           $ layout1_left_axis ^: laxis_override ^= axisTicksHide+ 	   $ layout1_plots ^= [ Left (toPlot price1), Left (toPlot spots) ]+           $ setLayout1Foreground (opaque black)+           $ defaultLayout1++    price1 = plot_lines_style ^= lineStyle+           $ plot_lines_values ^= [[ (d, v) | (d,v,_) <- prices1]]+           $ plot_lines_title ^= "price 1"+           $ defaultPlotLines++    spots = area_spots_4d_title ^= "random value"+          $ area_spots_4d_max_radius ^= 20+          $ area_spots_4d_values ^= values+          $ defaultAreaSpots4D+    +    points = map (\ (d,v,z,t)-> (d,v) ) values+    values = [ (d, v, z, t) | ((d,v,_),z,t) <- zip3 prices1 zs ts ]+    zs,ts :: [Int]+    zs     = randoms $ mkStdGen 0+    ts     = randomRs (-2,27) $ mkStdGen 1++    lineStyle = line_width ^= 3 * lwidth+              $ line_color ^= opaque blue+              $ defaultPlotLines ^. plot_lines_style++main1 :: [String] -> IO (PickFn ())+main1 ["small"]  = renderableToPNGFile (chart 0.25) 320 240 "test14_small.png"+main1 ["big"]    = renderableToPNGFile (chart 0.25) 800 600 "test14_big.png"+main1 _          = renderableToWindow  (chart 1.00) 640 480 >> return undefined++main = getArgs >>= main1

@@ -35,10 +35,10 @@   btitle = ""   mkstyle c = (solidFillStyle c, Nothing) -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile (chart (LORows 3)) 320 240 "test15_small.png" main1 ["big"]    = renderableToPNGFile (chart (LORows 3)) 800 600 "test15_big.png"-main1 _          = renderableToWindow  (chart (LORows 3)) 640 480+main1 _          = renderableToWindow  (chart (LORows 3)) 640 480 >> return undefined  main = getArgs >>= main1 

@@ -0,0 +1,82 @@+module Test17 where ++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Gtk+import Data.Colour+import Data.Colour.Names+import Data.Accessor+import System.Random+import System.Environment(getArgs)+import ExampleStocks++-- demonstrate Candles++chart :: Double -> Renderable ()+chart lwidth = toRenderable layout+  where+    layout = layout1_title ^="Stock Prices"+           $ layout1_background ^= solidFillStyle (opaque white)+           $ layout1_left_axis ^: laxis_override ^= axisTicksHide+ 	   $ layout1_plots ^= [ Right (toPlot msftArea)+                              , Right (toPlot msftLine)+                              , Right (toPlot msftCandle)+                              , Left  (toPlot aaplArea)+                              , Left  (toPlot aaplLine)+                              , Left  (toPlot aaplCandle) ]+           $ setLayout1Foreground (opaque black)+           $ defaultLayout1++    aaplLine = plot_lines_style  ^= lineStyle 2 green+             $ plot_lines_values ^= [[ (d, cl)+                                     | (d,(lo,op,cl,hi)) <- pricesAAPL]]+             $ plot_lines_title  ^= "AAPL closing"+             $ defaultPlotLines++    msftLine = plot_lines_style  ^= lineStyle 2 purple+             $ plot_lines_values ^= [[ (d, cl)+                                     | (d,(lo,op,cl,hi)) <- pricesMSFT]]+             $ plot_lines_title  ^= "MSFT closing"+             $ defaultPlotLines++    aaplArea = plot_fillbetween_style  ^= solidFillStyle (withOpacity green 0.4)+             $ plot_fillbetween_values ^= [ (d, (lo,hi))+                                          | (d,(lo,op,cl,hi)) <- pricesAAPL]+             $ plot_fillbetween_title  ^= "AAPL spread"+             $ defaultPlotFillBetween++    msftArea = plot_fillbetween_style ^= solidFillStyle (withOpacity purple 0.4)+             $ plot_fillbetween_values ^= [ (d, (lo,hi))+                                          | (d,(lo,op,cl,hi)) <- pricesMSFT]+             $ plot_fillbetween_title  ^= "MSFT spread"+             $ defaultPlotFillBetween++    aaplCandle = plot_candle_line_style  ^= lineStyle 1 blue+               $ plot_candle_fill        ^= True+               $ plot_candle_tick_length ^= 0+               $ plot_candle_width       ^= 2+               $ plot_candle_values      ^= [ Candle d lo op 0 cl hi+                                            | (d,(lo,op,cl,hi)) <- pricesAAPL]+               $ plot_candle_title       ^= "AAPL candle"+               $ defaultPlotCandle++    msftCandle = plot_candle_line_style  ^= lineStyle 1 red+               $ plot_candle_fill        ^= True+               $ plot_candle_rise_fill_style ^= solidFillStyle (opaque pink)+               $ plot_candle_fall_fill_style ^= solidFillStyle (opaque red)+               $ plot_candle_tick_length ^= 0+               $ plot_candle_width       ^= 2+               $ plot_candle_values      ^= [ Candle d lo op 0 cl hi+                                            | (d,(lo,op,cl,hi)) <- pricesMSFT]+               $ plot_candle_title       ^= "MSFT candle"+               $ defaultPlotCandle++    lineStyle n colour = line_width ^= n * lwidth+                       $ line_color ^= opaque colour+                       $ defaultPlotLines ^. plot_lines_style++main1 :: [String] -> IO (PickFn ())+main1 ["small"]  = renderableToPNGFile (chart 0.25) 320 240 "test17_small.png"+main1 ["big"]    = renderableToPNGFile (chart 0.25) 800 600 "test17_big.png"+main1 _          = renderableToWindow  (chart 1.00) 640 480 >> return undefined++main = getArgs >>= main1

@@ -56,9 +56,9 @@            $ setLayout1Foreground fg            $ defaultLayout1 -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile (chart prices2 True 0.25) 320 240 "test2_small.png" main1 ["big"]    = renderableToPNGFile (chart prices2 True 0.25) 800 600 "test2_big.png"-main1 _          = renderableToWindow  (chart prices2 True 1.00) 640 480+main1 _          = renderableToWindow  (chart prices2 True 1.00) 640 480 >> return undefined  main = getArgs >>= main1

@@ -32,9 +32,9 @@            $ defaultLayout1  -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile chart 320 240 "test3_small.png" main1 ["big"]    = renderableToPNGFile chart 800 600 "test3_big.png"-main1 _          = renderableToWindow  chart 640 480+main1 _          = renderableToWindow  chart 640 480 >> return undefined  main = getArgs >>= main1

@@ -29,10 +29,10 @@ 	   $ layout1_plots ^= [Left (toPlot points), Left (toPlot lines) ]            $ defaultLayout1 -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile (chart False False) 320 240 "test4_small.png" main1 ["big"]    = renderableToPNGFile (chart False False) 800 600 "test4_big.png"-main1 _          = renderableToWindow  (chart False False) 640 480+main1 _          = renderableToWindow  (chart False False) 640 480 >> return undefined  main = getArgs >>= main1 

@@ -40,10 +40,10 @@     s1 = solidLine lwidth $ opaque green     s2 = solidLine lwidth $ opaque blue -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile (chart 0.25) 320 240 "test5_small.png" main1 ["big"]    = renderableToPNGFile (chart 0.25) 800 600 "test5_big.png"-main1 _          = renderableToWindow  (chart 1.00) 640 480+main1 _          = renderableToWindow  (chart 1.00) 640 480 >> return undefined  main = getArgs >>= main1 

@@ -16,9 +16,9 @@                  [0.1,0.7,0.5::Double] "+"     xs = [0,0.3..3] :: [Double] -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile chart 320 240 "test6_small.png" main1 ["big"]    = renderableToPNGFile chart 800 600 "test6_big.png"-main1 _          = renderableToWindow  chart 640 480+main1 _          = renderableToWindow  chart 640 480 >> return undefined  main = getArgs >>= main1

@@ -26,10 +26,10 @@            $ defaultLayout1  -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile chart 320 240 "test7_small.png" main1 ["big"]    = renderableToPNGFile chart 800 600 "test7_big.png"-main1 _          = renderableToWindow  chart 640 480+main1 _          = renderableToWindow  chart 640 480 >> return undefined  main = getArgs >>= main1 

@@ -16,10 +16,10 @@                                        | (s,v,o) <- values ]            $ defaultPieLayout -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile chart 320 240 "test8_small.png" main1 ["big"]    = renderableToPNGFile chart 800 600 "test8_big.png"-main1 _          = renderableToWindow  chart 640 480+main1 _          = renderableToWindow  chart 640 480 >> return undefined  main = getArgs >>= main1 

@@ -30,10 +30,10 @@   bstyle = if borders then Just (solidLine 1.0 $ opaque black) else Nothing   mkstyle c = (solidFillStyle c, bstyle) -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile (chart True) 320 240 "test9_small.png" main1 ["big"]    = renderableToPNGFile (chart True) 800 600 "test9_big.png"-main1 _          = renderableToWindow  (chart True) 640 480+main1 _          = renderableToWindow  (chart True) 640 480 >> return undefined  main = getArgs >>= main1 

@@ -22,9 +22,9 @@            $ layout1_plots ^= [Left (toPlot circleP)]            $ defaultLayout1 -main1 :: [String] -> IO()+main1 :: [String] -> IO (PickFn ()) main1 ["small"]  = renderableToPNGFile (chart 1.00) 320 240 "test_parametric_small.png" main1 ["big"]    = renderableToPNGFile (chart 1.00) 800 600 "test_parametric_big.png"-main1 _          = renderableToWindow  (chart 1.00) 640 480+main1 _          = renderableToWindow  (chart 1.00) 640 480 >> return undefined  main = getArgs >>= main1

@@ -27,7 +27,9 @@ import qualified Test8 import qualified Test9 import qualified Test14+import qualified Test14a import qualified Test15+import qualified Test17 import qualified TestParametric  data OutputType = Window | PNG | PS | PDF | SVG@@ -254,16 +256,18 @@      baxis = AxisData {         axis_viewport_ = vmap (0,15),+        axis_tropweiv_ = invmap (0,15),         axis_ticks_    = [(v,3) | v <- [0,1..15]],         axis_grid_     = [0,5..15],-        axis_labels_   = [(v,show v) | v <- [0,5..15]]+        axis_labels_   = [[(v,show v) | v <- [0,5..15]]]     }          laxis = AxisData {         axis_viewport_ = vmap (0,500),+        axis_tropweiv_ = invmap (0,500),         axis_ticks_    = [(v,3) | v <- [0,25..500]],         axis_grid_     = [0,100..500],-        axis_labels_   = [(v,show v) | v <- [0,100..500]]+        axis_labels_   = [[(v,show v) | v <- [0,100..500]]]     }          plot = plot_lines_values ^= [vs1]@@ -293,11 +297,11 @@     annotated h v = toRenderable ( layout1_plots ^= [Left (toPlot labelPlot), Left (toPlot rotPlot), p] $ defaultLayout1 )       where labelPlot = plot_annotation_hanchor ^= h                       $ plot_annotation_vanchor ^= v-                      $ plot_annotation_values  ^= [(x,x,"Hello World (plain)")|x<-points]+                      $ plot_annotation_values  ^= [(x,x,"Hello World\n(plain)")|x<-points]                       $ defaultPlotAnnotation             rotPlot =   plot_annotation_angle ^= -45.0                       $ plot_annotation_style ^= defaultFontStyle{font_size_=10,font_weight_=C.FontWeightBold, font_color_ =(opaque blue) }-                      $ plot_annotation_values  ^= [(x,x,"Hello World (fancy)")|x<-points]+                      $ plot_annotation_values  ^= [(x,x,"Hello World\n(fancy)")|x<-points]                       $ labelPlot  @@ -329,11 +333,28 @@ allTests =      [ ("test1",  \o -> Test1.chart (chooseLineWidth o) )      , ("test1a", \o -> test1a (chooseLineWidth o) )-     , ("test2a", \o -> Test2.chart prices False (chooseLineWidth o))-     , ("test2b", \o -> Test2.chart prices1 False (chooseLineWidth o))-     , ("test2c", \o -> Test2.chart prices2 False (chooseLineWidth o))-     , ("test2d", \o -> Test2.chart prices3 False (chooseLineWidth o))-     , ("test2e", \o -> Test2.chart prices4 True (chooseLineWidth o))+     , ("test2a", \o -> Test2.chart prices    False (chooseLineWidth o))+     , ("test2b", \o -> Test2.chart prices1   False (chooseLineWidth o))+     , ("test2c", \o -> Test2.chart prices2   False (chooseLineWidth o))+     , ("test2d", \o -> Test2.chart prices5   True  (chooseLineWidth o))+     , ("test2e", \o -> Test2.chart prices6   True  (chooseLineWidth o))+     , ("test2f", \o -> Test2.chart prices7   True  (chooseLineWidth o))+     , ("test2g", \o -> Test2.chart prices3   False (chooseLineWidth o))+     , ("test2h", \o -> Test2.chart prices8   True  (chooseLineWidth o))+     , ("test2i", \o -> Test2.chart prices9   True  (chooseLineWidth o))+     , ("test2j", \o -> Test2.chart prices10  True  (chooseLineWidth o))+     , ("test2k", \o -> Test2.chart prices10a True  (chooseLineWidth o))+     , ("test2m", \o -> Test2.chart prices11  True  (chooseLineWidth o))+     , ("test2n", \o -> Test2.chart prices10b True  (chooseLineWidth o))+     , ("test2o", \o -> Test2.chart prices12  True  (chooseLineWidth o))+     , ("test2p", \o -> Test2.chart prices13  True  (chooseLineWidth o))+     , ("test2q", \o -> Test2.chart prices13a True  (chooseLineWidth o))+     , ("test2r", \o -> Test2.chart prices13b True  (chooseLineWidth o))+     , ("test2s", \o -> Test2.chart prices14  True  (chooseLineWidth o))+     , ("test2t", \o -> Test2.chart prices14a True  (chooseLineWidth o))+     , ("test2u", \o -> Test2.chart prices14b True  (chooseLineWidth o))+     , ("test2v", \o -> Test2.chart prices14c True  (chooseLineWidth o))+     , ("test2w", \o -> Test2.chart prices14d True  (chooseLineWidth o))      , ("test3",  const Test3.chart)      , ("test4a", const (Test4.chart False False))      , ("test4b", const (Test4.chart True False))@@ -353,10 +374,12 @@      , ("test12", test12)      , ("test13", test13)      , ("test14", \o -> Test14.chart (chooseLineWidth o) )+     , ("test14a", \o -> Test14a.chart (chooseLineWidth o) )      , ("test15a", const (Test15.chart (LORows 2)))      , ("test15b", const (Test15.chart (LOCols 2)))-     , ("misc1", misc1 0)-     , ("misc1a", misc1 45)+     , ("test17",  \o -> Test17.chart (chooseLineWidth o))+     , ("misc1", setPickFn nullPickFn . misc1 0)+     , ("misc1a", setPickFn nullPickFn . misc1 45)      , ("parametric", \o -> TestParametric.chart (chooseLineWidth o) )      ] @@ -372,7 +395,12 @@ main1 tests = showTests tests renderToWindow  showTests :: [String] -> ((String,OutputType -> Renderable ()) -> IO()) -> IO ()-showTests tests ofn = mapM_ ofn (filter (match tests) allTests)+showTests tests ofn = mapM_ doTest (filter (match tests) allTests)+   where+     doTest (s,f) = do+       putStrLn (s ++ "... ")+       ofn (s,f)+       match :: [String] -> (String,a) -> Bool match [] t = True@@ -380,6 +408,7 @@  renderToWindow (n,ir) = renderableToWindow (ir Window) 640 480 renderToPNG (n,ir) = renderableToPNGFile (ir PNG) 640 480 (n ++ ".png")+                     >> return () renderToPS (n,ir) = renderableToPSFile (ir PS) 640 480 (n ++ ".ps") renderToPDF (n,ir) = renderableToPDFFile (ir PDF) 640 480 (n ++ ".pdf") renderToSVG (n,ir) = renderableToSVGFile (ir SVG) 640 480 (n ++ ".svg")