Chart 0.17 → 1.0

raw patch · 52 files changed

+2354/−3425 lines, 52 filesdep +data-default-classdep +lensdep +operationaldep −cairodep −data-accessordep −data-accessor-templatedep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: data-default-class, lens, operational

Dependencies removed: cairo, data-accessor, data-accessor-template

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Chart.cabal +14/−30
• Graphics/Rendering/Chart.hs +4/−2
• Graphics/Rendering/Chart/Axis.hs +0/−3
• Graphics/Rendering/Chart/Axis/Floating.hs +33/−22
• Graphics/Rendering/Chart/Axis/Indexed.hs +5/−6
• Graphics/Rendering/Chart/Axis/Int.hs +8/−10
• Graphics/Rendering/Chart/Axis/LocalTime.hs +8/−11
• Graphics/Rendering/Chart/Axis/Types.hs +97/−103
• Graphics/Rendering/Chart/Axis/Unit.hs +5/−8
• Graphics/Rendering/Chart/Backend.hs +63/−0
• Graphics/Rendering/Chart/Backend/Impl.hs +143/−0
• Graphics/Rendering/Chart/Backend/Types.hs +183/−0
• Graphics/Rendering/Chart/Drawing.hs +465/−0
• Graphics/Rendering/Chart/Geometry.hs +376/−0
• Graphics/Rendering/Chart/Grid.hs +11/−12
• Graphics/Rendering/Chart/Layout.hs +152/−136
• Graphics/Rendering/Chart/Legend.hs +27/−26
• Graphics/Rendering/Chart/Plot.hs +0/−3
• Graphics/Rendering/Chart/Plot/Annotation.hs +34/−34
• Graphics/Rendering/Chart/Plot/AreaSpots.hs +97/−92
• Graphics/Rendering/Chart/Plot/Bars.hs +64/−63
• Graphics/Rendering/Chart/Plot/Candle.hs +71/−78
• Graphics/Rendering/Chart/Plot/ErrBars.hs +47/−46
• Graphics/Rendering/Chart/Plot/FillBetween.hs +30/−29
• Graphics/Rendering/Chart/Plot/Hidden.hs +10/−15
• Graphics/Rendering/Chart/Plot/Lines.hs +48/−49
• Graphics/Rendering/Chart/Plot/Pie.hs +107/−90
• Graphics/Rendering/Chart/Plot/Points.hs +31/−30
• Graphics/Rendering/Chart/Plot/Types.hs +17/−20
• Graphics/Rendering/Chart/Renderable.hs +92/−164
• Graphics/Rendering/Chart/Simple.hs +6/−1
• Graphics/Rendering/Chart/Simple/Internal.hs +63/−69
• Graphics/Rendering/Chart/SparkLine.hs +27/−31
• Graphics/Rendering/Chart/Types.hs +0/−611
• Graphics/Rendering/Chart/Utils.hs +16/−0
• tests/ExampleStocks.hs +0/−219
• tests/Prices.hs +0/−392
• tests/Test1.hs +0/−39
• tests/Test14.hs +0/−46
• tests/Test14a.hs +0/−48
• tests/Test15.hs +0/−43
• tests/Test17.hs +0/−80
• tests/Test2.hs +0/−62
• tests/Test3.hs +0/−38
• tests/Test4.hs +0/−37
• tests/Test5.hs +0/−48
• tests/Test6.hs +0/−22
• tests/Test7.hs +0/−34
• tests/Test8.hs +0/−24
• tests/Test9.hs +0/−38
• tests/TestParametric.hs +0/−28
• tests/all_tests.hs +0/−433

@@ -1,5 +1,5 @@ Name: Chart-Version: 0.17+Version: 1.0 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2010@@ -12,39 +12,20 @@ Cabal-Version: >= 1.6 Build-Type: Simple -Extra-Source-Files:-     tests/all_tests.hs,-     tests/Test1.hs,-     tests/Test2.hs,-     tests/Test3.hs,-     tests/Test4.hs,-     tests/Test5.hs,-     tests/Test6.hs,-     tests/Test7.hs,-     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.- library-  if flag(splitbase)-    Build-depends: base >= 3 && < 5, old-locale, time, mtl, array-  else-    Build-depends: base < 3-  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+  Build-depends: base >= 3 && < 5+               , old-locale+               , time, mtl, array+               , lens >= 3.9+               , colour >= 2.2.1+               , data-default-class < 0.1+               , operational >= 0.2.2    Exposed-modules:         Graphics.Rendering.Chart,-        Graphics.Rendering.Chart.Types,+        Graphics.Rendering.Chart.Drawing,+        Graphics.Rendering.Chart.Geometry,+        Graphics.Rendering.Chart.Utils,         Graphics.Rendering.Chart.Renderable,         Graphics.Rendering.Chart.Axis,         Graphics.Rendering.Chart.Axis.Floating,@@ -71,6 +52,9 @@         Graphics.Rendering.Chart.Plot.Pie,         Graphics.Rendering.Chart.Plot.Points         Graphics.Rendering.Chart.SparkLine+        Graphics.Rendering.Chart.Backend+        Graphics.Rendering.Chart.Backend.Impl+        Graphics.Rendering.Chart.Backend.Types  source-repository head   type:     git

@@ -32,7 +32,8 @@  module Graphics.Rendering.Chart( -    module Graphics.Rendering.Chart.Types,+    module Graphics.Rendering.Chart.Geometry,+    module Graphics.Rendering.Chart.Drawing,     module Graphics.Rendering.Chart.Renderable,     module Graphics.Rendering.Chart.Layout,     module Graphics.Rendering.Chart.Axis,@@ -41,7 +42,8 @@  ) where -import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Layout import Graphics.Rendering.Chart.Axis

@@ -7,9 +7,6 @@ -- Code to calculate and render axes. -- -{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -XTemplateHaskell #-}- module Graphics.Rendering.Chart.Axis(     module Graphics.Rendering.Chart.Axis.Types,     module Graphics.Rendering.Chart.Axis.Floating,

@@ -9,7 +9,7 @@ --  {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Axis.Floating(     Percent(..),@@ -32,10 +32,13 @@  import Data.List(minimumBy) import Data.Ord (comparing)+import Data.Default.Class import Numeric (showFFloat) -import Data.Accessor.Template-import Graphics.Rendering.Chart.Types+import Control.Lens+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing+import Graphics.Rendering.Chart.Utils import Graphics.Rendering.Chart.Axis.Types  instance PlotValue Double where@@ -54,7 +57,7 @@ instance PlotValue Percent where     toValue  = unPercent     fromValue= Percent-    autoAxis = autoScaledAxis defaultLinearAxis{-la_labelf_=-}+    autoAxis = autoScaledAxis defaultLinearAxis{-_la_labelf=-}  -- | A wrapper class for doubles used to indicate they are to -- be plotted against a log axis.@@ -76,34 +79,38 @@  data LinearAxisParams a = LinearAxisParams {     -- | The function used to show the axes labels.-    la_labelf_  :: a -> String,+    _la_labelf  :: a -> String,      -- | The target number of labels to be shown.-    la_nLabels_ :: Int,+    _la_nLabels :: Int,      -- | The target number of ticks to be shown.-    la_nTicks_  :: Int+    _la_nTicks  :: Int } +{-# DEPRECATED defaultLinearAxis "Use the according Data.Default instance!" #-} defaultLinearAxis :: (Show a, RealFloat a) => LinearAxisParams a-defaultLinearAxis = LinearAxisParams {-    la_labelf_    = showD,-    la_nLabels_   = 5,-    la_nTicks_    = 50-}+defaultLinearAxis = def +instance (Show a, RealFloat a) => Default (LinearAxisParams a) where+  def = LinearAxisParams +    { _la_labelf    = showD+    , _la_nLabels   = 5+    , _la_nTicks    = 50+    }+ -- | Generate a linear axis with the specified bounds scaledAxis :: RealFloat a => LinearAxisParams a -> (a,a) -> AxisFn a scaledAxis lap (min,max) ps0 = makeAxis' realToFrac realToFrac-                                         (la_labelf_ lap) (labelvs,tickvs,gridvs)+                                         (_la_labelf lap) (labelvs,tickvs,gridvs)   where     ps        = filter isValidNumber ps0     range []  = (0,1)     range _   | min == max = if min==0 then (-1,1) else                              let d = abs (min * 0.01) in (min-d,max+d)               | otherwise  = (min,max)-    labelvs   = map fromRational $ steps (fromIntegral (la_nLabels_ lap)) r-    tickvs    = map fromRational $ steps (fromIntegral (la_nTicks_ lap))+    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@@ -147,17 +154,21 @@  ---------------------------------------------------------------------- +{-# DEPRECATED defaultLogAxis "Use the according Data.Default instance!" #-} defaultLogAxis :: (Show a, RealFloat a) => LogAxisParams a-defaultLogAxis = LogAxisParams {-    loga_labelf_ = showD-}+defaultLogAxis = def +instance (Show a, RealFloat a) => Default (LogAxisParams a) where+  def = 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)+              (_loga_labelf lap) (wrap rlabelvs, wrap rtickvs, wrap rgridvs)         where           ps        = filter (\x -> isValidNumber x && 0 < x) ps0           (min,max) = (minimum ps,maximum ps)@@ -170,7 +181,7 @@  data LogAxisParams a = LogAxisParams {     -- | The function used to show the axes labels.-    loga_labelf_ :: a -> String+    _loga_labelf :: a -> String }  {-@@ -228,6 +239,6 @@  where   (a,b) = properFraction x -$( deriveAccessors ''LinearAxisParams )-$( deriveAccessors ''LogAxisParams )+$( makeLenses ''LinearAxisParams )+$( makeLenses ''LogAxisParams ) 

@@ -7,7 +7,6 @@ -- Calculate and render indexed axes  {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -XTemplateHaskell #-}  module Graphics.Rendering.Chart.Axis.Indexed(     PlotIndex(..),@@ -35,12 +34,12 @@ --   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)+    _axis_viewport = vport,+    _axis_tropweiv = invport,+    _axis_ticks    = [],+    _axis_labels   = [filter (\(i,l) -> i >= imin && i <= imax)                             (zip [0..] labels)],-    axis_grid_     = []+    _axis_grid     = []     }   where     vport r i = linMap id ( fromIntegral imin - 0.5

@@ -6,9 +6,6 @@ -- -- Calculate and render integer indexed axes -{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -XTemplateHaskell #-}- module Graphics.Rendering.Chart.Axis.Int(     defaultIntAxis,     scaledIntAxis,@@ -16,7 +13,8 @@ ) where  import Data.List(genericLength)-import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Axis.Types import Graphics.Rendering.Chart.Axis.Floating @@ -32,9 +30,9 @@  defaultIntAxis :: (Show a) => LinearAxisParams a defaultIntAxis  = LinearAxisParams {-    la_labelf_  = show,-    la_nLabels_ = 5,-    la_nTicks_  = 10+    _la_labelf  = show,+    _la_nLabels = 5,+    _la_nTicks  = 10 }  autoScaledIntAxis :: (Integral i, PlotValue i) =>@@ -46,14 +44,14 @@ scaledIntAxis :: (Integral i, PlotValue i) =>                  LinearAxisParams i -> (i,i) -> AxisFn i scaledIntAxis lap (min,max) ps =-    makeAxis (la_labelf_ lap) (labelvs,tickvs,gridvs)+    makeAxis (_la_labelf lap) (labelvs,tickvs,gridvs)   where     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)+    labelvs   = stepsInt (fromIntegral $ _la_nLabels lap) r+    tickvs    = stepsInt (fromIntegral $ _la_nTicks lap)                                   ( fromIntegral $ minimum labelvs                                   , fromIntegral $ maximum labelvs )     gridvs    = labelvs

@@ -6,27 +6,24 @@ -- -- 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 Control.Lens import Data.Colour (opaque) import Data.Colour.Names (black, lightgrey) import Data.Ord (comparing) -import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Axis.Types @@ -90,13 +87,13 @@                        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]+    _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]+    _axis_grid     = [ t     | t <- ltimes, visible t]     }   where     (min,max)    = case pts of

@@ -7,8 +7,7 @@ -- Type definitions for Axes -- -{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Axis.Types(     AxisData(..),@@ -54,18 +53,19 @@  ) where -import qualified Graphics.Rendering.Cairo as C import Data.Time import Data.Fixed import Data.Maybe import System.Locale (defaultTimeLocale) import Control.Monad import Data.List(sort,intersperse)-import Data.Accessor.Template+import Control.Lens import Data.Colour (opaque) import Data.Colour.Names (black, lightgrey)+import Data.Default.Class -import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Renderable  -- | A typeclass abstracting the functions we need@@ -78,11 +78,11 @@ -- | 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_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 _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@@ -90,28 +90,28 @@     --   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)],+    _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)]],+    _axis_labels   :: [[(x, String)]],      -- | The positions on the axis (in viewport units) where     --   we want to show grid lines.-    axis_grid_     :: [ x ]+    _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,+    _axis_line_style  :: LineStyle,+    _axis_label_style :: FontStyle,+    _axis_grid_style  :: LineStyle,      -- | How far the labels are to be drawn from the axis.-    axis_label_gap_   :: Double+    _axis_label_gap   :: Double }  -- | A function to generate the axis data, given the data values@@ -134,47 +134,46 @@  -- | Modifier to remove grid lines from an axis axisGridHide         :: AxisData x -> AxisData x-axisGridHide ad       = ad{ axis_grid_ = [] }+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) }+axisGridAtTicks ad    = ad{ _axis_grid = map fst (_axis_ticks ad) }  -- | Modifier to position grid lines to line up with only the major ticks axisGridAtBigTicks   :: AxisData x -> AxisData x-axisGridAtBigTicks ad = ad{ axis_grid_ =+axisGridAtBigTicks ad = ad{ _axis_grid =                             map fst $-                            filter ((> minimum (map (abs.snd) (axis_ticks_ ad))).snd) $-                            axis_ticks_ ad }+                            filter ((> minimum (map (abs.snd) (_axis_ticks ad))).snd) $+                            _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 }+axisGridAtLabels ad   = ad{ _axis_grid = map fst vs }   where-    vs = case axis_labels_ ad of+    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_  = [] }+axisTicksHide ad     = ad{ _axis_ticks  = [] }  -- | Modifier to remove labels from an axis axisLabelsHide      :: AxisData x -> AxisData x-axisLabelsHide ad    = ad{ axis_labels_ = []}+axisLabelsHide ad    = ad{ _axis_labels = []}  -- | Modifier to change labels on an axis axisLabelsOverride  :: [(x,String)] -> AxisData x -> AxisData x-axisLabelsOverride o ad = ad{ axis_labels_ = [o] }+axisLabelsOverride o ad = ad{ _axis_labels = [o] } -minsizeAxis :: AxisT x -> CRender RectSize+minsizeAxis :: AxisT x -> ChartBackend RectSize minsizeAxis (AxisT at as rev ad) = do-    labelSizes <- preserveCState $ do-        setFontStyle (axis_label_style_ as)-        mapM (mapM textSize) (labelTexts ad)+    labelSizes <- withFontStyle (_axis_label_style as) $ do+      mapM (mapM textDimension) (labelTexts ad) -    let ag      = axis_label_gap_ as-    let tsize   = maximum ([0] ++ [ max 0 (-l) | (v,l) <- axis_ticks_ 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)@@ -190,56 +189,51 @@     return sz  labelTexts :: AxisData a -> [[String]]-labelTexts ad = map (map snd) (axis_labels_ ad)+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 :: (Ord x) => AxisT x -> ChartBackend (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+    let labels = map snd . sort . concat . _axis_labels $ ad+    labelSizes <- withFontStyle (_axis_label_style as) $ do+      mapM textDimension 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+      []  -> 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 :: AxisT x -> RectSize -> ChartBackend (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+  let ls = _axis_line_style as+  withLineStyle (ls {_line_cap = LineCapSquare}) $ do+    p <- alignStrokePoints [Point sx sy,Point ex ey]+    strokePointPath p+  withLineStyle (ls {_line_cap = LineCapButt}) $ do+    mapM_ drawTick (_axis_ticks ad)+  withFontStyle (_axis_label_style as) $ do+    labelSizes <- mapM (mapM textDimension) (labelTexts ad)+    let sizes = map ((+ag).maximum0.map coord) labelSizes+    let offsets = scanl (+) ag sizes+    mapM_ drawLabels (zip offsets  (_axis_labels ad))+  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]+           t2 = t1 `pvadd` (vscale length tp)+       in alignStrokePoints [t1,t2] >>= strokePointPath     (hta,vta,coord,awayFromAxis) = case et of        E_Top    -> (HTA_Centre, VTA_Bottom, snd, \v -> (Vector 0 (-v)))@@ -262,10 +256,10 @@         mapM_ drawLabel labels'      where        drawLabel (value,s) = do-           drawText hta vta (axisPoint value `pvadd` (awayFromAxis offset)) s-           textSize s+           drawTextA hta vta (axisPoint value `pvadd` (awayFromAxis offset)) s+           textDimension s -   ag = axis_label_gap_ as+   ag = _axis_label_gap as    pickfn = Just . invAxisPoint  hBufferRect :: Rect -> Rect@@ -310,20 +304,19 @@     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)+    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+    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 :: RectSize -> AxisT z -> ChartBackend () renderAxisGrid sz@(w,h) at@(AxisT re as rev ad) = do-    preserveCState $ do-        setLineStyle (axis_grid_style_ as)-        mapM_ (drawGridLine re) (axis_grid_ ad)+    withLineStyle (_axis_grid_style as) $ do+      mapM_ (drawGridLine re) (_axis_grid ad)   where     (sx,sy,ex,ey,tp,axisPoint,invAxisPoint) = axisMapping at sz @@ -333,21 +326,21 @@     drawGridLine E_Right  = hline      vline v = let v' = p_x (axisPoint v)-	      in strokePath [Point v' 0,Point v' h]+              in alignStrokePoints [Point v' 0,Point v' h] >>= strokePointPath      hline v = let v' = p_y (axisPoint v)-	      in strokePath [Point 0 v',Point w v']+              in alignStrokePoints [Point 0 v',Point w v'] >>= strokePointPath   -- | 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]+    _axis_viewport = newViewport,+    _axis_tropweiv = newTropweiv,+    _axis_ticks    = newTicks,+    _axis_grid     = gridvs,+    _axis_labels   = [newLabels]     }   where     newViewport = vmap (min',max')@@ -362,30 +355,34 @@ 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 ]]+    _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 :: LineStyle defaultAxisLineStyle = solidLine 1 $ opaque black -defaultGridLineStyle :: CairoLineStyle+defaultGridLineStyle :: LineStyle defaultGridLineStyle = dashedLine 1 [5,5] $ opaque lightgrey +{-# DEPRECATED defaultAxisStyle "Use the according Data.Default instance!" #-} defaultAxisStyle :: AxisStyle-defaultAxisStyle = AxisStyle {-    axis_line_style_  = defaultAxisLineStyle,-    axis_label_style_ = defaultFontStyle,-    axis_grid_style_  = defaultGridLineStyle,-    axis_label_gap_   = 10-}+defaultAxisStyle = def +instance Default AxisStyle where+  def = AxisStyle +    { _axis_line_style  = defaultAxisLineStyle+    , _axis_label_style = def+    , _axis_grid_style  = defaultGridLineStyle+    , _axis_label_gap   = 10+    }+ ----------------------------------------------------------------------  -- | A linear mapping of points in one range to another.@@ -412,9 +409,6 @@   where     doubleRange = t v4 - t v3 -------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor for--- each field.-$( deriveAccessors ''AxisData )-$( deriveAccessors ''AxisStyle )+$( makeLenses ''AxisData )+$( makeLenses ''AxisStyle ) 

@@ -6,9 +6,6 @@ -- -- Calculate and render unit indexed axes -{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -XTemplateHaskell #-}- module Graphics.Rendering.Chart.Axis.Unit(     unitAxis, ) where@@ -22,9 +19,9 @@  unitAxis :: AxisData () unitAxis = AxisData {-    axis_viewport_ = \(x0,x1) _ -> (x0+x1)/2,-    axis_tropweiv_ = \_       _ -> (),-    axis_ticks_    = [((), 0)],-    axis_labels_   = [[((), "")]],-    axis_grid_     = []+    _axis_viewport = \(x0,x1) _ -> (x0+x1)/2,+    _axis_tropweiv = \_       _ -> (),+    _axis_ticks    = [((), 0)],+    _axis_labels   = [[((), "")]],+    _axis_grid     = [] }

@@ -0,0 +1,63 @@+-- | This module provides the API for drawing operations abstracted+-- to arbitrary 'ChartBackend's.+module Graphics.Rendering.Chart.Backend+  (+  -- * The backend Monad+    ChartBackend(..)+  , CRender+  +  -- * Backend Operations+  , fillPath+  , strokePath+  , drawText, textSize+  , withTransform+  , withClipRegion+  , withFontStyle, withFillStyle, withLineStyle+  +  -- * Backend Helpers+--  , getTransform+--  , getFillStyle, getFontStyle+--  , getLineStyle, getClipRegion+  , getPointAlignFn, getCoordAlignFn++  -- * Text Metrics+  , TextSize(..)                     +  +  -- * Line Types+  , LineCap(..)+  , LineJoin(..)+  , LineStyle(..)+  +  , line_width+  , line_color+  , line_dashes+  , line_cap+  , line_join+  +  -- * Fill Types+  , FillStyle(..)++  -- * Font and Text Types+  , FontWeight(..)+  , FontSlant(..)+  , FontStyle(..)++  , defaultFontStyle+  +  , HTextAnchor(..)+  , VTextAnchor(..)++  , font_name+  , font_size+  , font_slant+  , font_weight+  , font_color+  +  , AlignmentFn+  , AlignmentFns+  , vectorAlignmentFns+  , bitmapAlignmentFns+  ) where++import Graphics.Rendering.Chart.Backend.Types+import Graphics.Rendering.Chart.Backend.Impl

@@ -0,0 +1,143 @@+{-# LANGUAGE GADTs #-}++-- | This module provides the implementation details common to all 'ChartBackend's.+module Graphics.Rendering.Chart.Backend.Impl where++import Data.Monoid+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Operational++import Data.Default.Class++import Data.Colour+import Data.Colour.Names++import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Backend.Types++-- -----------------------------------------------------------------------+-- Rendering Backend Class+-- -----------------------------------------------------------------------++-- | The abstract drawing operation generated when using the+--   the chart drawing API.+--   +--   See the documentation of the different function for the correct semantics+--   of each instruction:+--   +--   * 'strokePath', 'fillPath'+--   +--   * 'drawText', 'textSize'+--   +--   * 'getPointAlignFn', 'getCoordAlignFn', 'AlignmentFns'+--   +--   * 'withTransform', 'withClipRegion'+--   +--   * 'withLineStyle', 'withFillStyle', 'withFontStyle'+--   +data ChartBackendInstr a where+  StrokePath :: Path -> ChartBackendInstr ()+  FillPath   :: Path -> ChartBackendInstr ()+  GetTextSize :: String -> ChartBackendInstr TextSize+  DrawText    :: Point -> String -> ChartBackendInstr ()+  GetAlignments :: ChartBackendInstr AlignmentFns+  WithTransform  :: Matrix ->  Program ChartBackendInstr a -> ChartBackendInstr a+  WithFontStyle  :: FontStyle -> Program ChartBackendInstr a -> ChartBackendInstr a+  WithFillStyle  :: FillStyle -> Program ChartBackendInstr a -> ChartBackendInstr a+  WithLineStyle  :: LineStyle -> Program ChartBackendInstr a -> ChartBackendInstr a+  WithClipRegion :: Rect -> Program ChartBackendInstr a -> ChartBackendInstr a++-- | A 'ChartBackend' provides the capability to render a chart somewhere.+--   +--   The coordinate system of the backend has its initial origin (0,0)+--   in the top left corner of the drawing plane. The x-axis points +--   towards the top right corner and the y-axis points towards +--   the bottom left corner. The unit used by coordinates, the font size,+--   and lengths is the always the same, but depends on the backend.+--   All angles are measured in radians.+--   +--   The line, fill and font style are set to their default values +--   initially.+--   +--   Information about the semantics of the instructions can be +--   found in the documentation of 'ChartBackendInstr'.+type ChartBackend a = Program ChartBackendInstr a++{-# DEPRECATED CRender  "Use the new name ChartBackend!" #-}+-- | Alias so the old name for rendering code still works.+type CRender a = ChartBackend a++-- | Stroke the outline of the given path using the +--   current 'LineStyle'. This function does /not/ perform+--   alignment operations on the path. See 'Path' for the exact semantic+--   of paths.+strokePath :: Path -> ChartBackend ()+strokePath p = singleton (StrokePath p)++-- | Fill the given path using the current 'FillStyle'.+--   The given path will be closed prior to filling.+--   This function does /not/ perform+--   alignment operations on the path.+--   See 'Path' for the exact semantic of paths.+fillPath :: Path -> ChartBackend ()+fillPath p = singleton (FillPath p)++-- | Calculate a 'TextSize' object with rendering information+--   about the given string without actually rendering it.+textSize :: String -> ChartBackend TextSize+textSize text = singleton (GetTextSize text)++-- | Draw a single-line textual label anchored by the baseline (vertical) +--   left (horizontal) point. Uses the current 'FontStyle' for drawing.+drawText :: Point -> String -> ChartBackend ()+drawText p text = singleton (DrawText p text)++-- | Apply the given transformation in this local+--   environment when drawing. The given transformation +--   is applied after the current transformation. This+--   means both are combined.+withTransform :: Matrix -> ChartBackend a -> ChartBackend a+withTransform t p = singleton (WithTransform t p)++-- | Use the given font style in this local+--   environment when drawing text.+--   +--   An implementing backend is expected to guarentee+--   to support the following font families: @serif@, @sans-serif@ and @monospace@;+--   +--   If the backend is not able to find or load a given font +--   it is required to fall back to a custom fail-safe font+--   and use it instead.+withFontStyle :: FontStyle -> ChartBackend a -> ChartBackend a+withFontStyle fs p = singleton (WithFontStyle fs p)++-- | Use the given fill style in this local+--   environment when filling paths.+withFillStyle :: FillStyle -> ChartBackend a -> ChartBackend a+withFillStyle fs p = singleton (WithFillStyle fs p)++-- | Use the given line style in this local+--   environment when stroking paths.+withLineStyle :: LineStyle -> ChartBackend a -> ChartBackend a+withLineStyle ls p = singleton (WithLineStyle ls p)++-- | Use the given clipping rectangle when drawing+--   in this local environment. The new clipping region+--   is intersected with the given clip region. You cannot +--   escape the clip!+withClipRegion :: Rect -> ChartBackend a -> ChartBackend a+withClipRegion c p = singleton (WithClipRegion c p)++-- -----------------------------------------------------------------------+-- Rendering Utility Functions+-- -----------------------------------------------------------------------++-- | Get the point alignment function+getPointAlignFn :: ChartBackend (Point->Point)+getPointAlignFn = liftM afPointAlignFn (singleton GetAlignments)++-- | Get the coordinate alignment function+getCoordAlignFn :: ChartBackend (Point->Point)+getCoordAlignFn = liftM afCoordAlignFn (singleton GetAlignments)+

@@ -0,0 +1,183 @@+{-# LANGUAGE TemplateHaskell #-}++module Graphics.Rendering.Chart.Backend.Types where++import Data.Default.Class+import Data.Colour+import Data.Colour.Names+import Control.Lens++import Graphics.Rendering.Chart.Geometry++-- -----------------------------------------------------------------------+-- Line Types+-- -----------------------------------------------------------------------++-- | The different supported line ends.+data LineCap = LineCapButt   -- ^ Just cut the line straight.+             | LineCapRound  -- ^ Make a rounded line end.+             | LineCapSquare -- ^ Make a square that ends the line.+             deriving (Show, Eq, Ord)++-- | The different supported ways to join line ends.+data LineJoin = LineJoinMiter -- ^ Extends the outline until they meet each other.+              | LineJoinRound -- ^ Draw a circle fragment to connet line end.+              | LineJoinBevel -- ^ Like miter, but cuts it off if a certain +                              --   threshold is exceeded.+              deriving (Show, Eq, Ord)++-- | Data type for the style of a line.+data LineStyle = LineStyle +  { _line_width  :: Double+  -- ^ The thickness of a line in device units.+  , _line_color  :: AlphaColour Double+  -- ^ The color of a line.+  , _line_dashes :: [Double]+  -- ^ The dash pattern. Every value at a even index gives a dash width and +  --   every value at a odd index gives a gap width in device units.+  , _line_cap    :: LineCap+  -- ^ How to end a line.+  , _line_join   :: LineJoin+  -- ^ How to connect two lines.+  } deriving (Show, Eq)++-- | The default line style.+instance Default LineStyle where+  def = LineStyle +    { _line_width  = 1+    , _line_color  = opaque black+    , _line_dashes = []+    , _line_cap    = LineCapButt+    , _line_join   = LineJoinBevel+    }++-- -----------------------------------------------------------------------+-- Font & Text Types+-- -----------------------------------------------------------------------++-- | The possible slants of a font.+data FontSlant = FontSlantNormal  -- ^ Normal font style without slant.+               | FontSlantItalic  -- ^ With a slight slant.+               | FontSlantOblique -- ^ With a greater slant.+               deriving (Show, Eq, Ord)++-- | The default font slant.+instance Default FontSlant where+  def = FontSlantNormal++-- | The possible weights of a font.+data FontWeight = FontWeightNormal -- ^ Normal font style without weight.+                | FontWeightBold   -- ^ Bold font.+                deriving (Show, Eq, Ord)++-- | The default font weight.+instance Default FontWeight where+  def = FontWeightNormal++-- | Data type for a font.+data FontStyle = FontStyle {+      _font_name   :: String,+      -- ^ The font family or font face to use.+      _font_size   :: Double,+      -- ^ The height of the rendered font in device coordinates.+      _font_slant  :: FontSlant,+      -- ^ The slant to render with.+      _font_weight :: FontWeight,+      -- ^ The weight to render with.+      _font_color  :: AlphaColour Double+      -- ^ The color to render text with.+} deriving (Show, Eq)++-- | The default font style.+instance Default FontStyle where+  def = FontStyle +    { _font_name   = "sans-serif"+    , _font_size   = 10+    , _font_slant  = def+    , _font_weight = def+    , _font_color  = opaque black+    }++{-# DEPRECATED defaultFontStyle  "Use the according Data.Default instance!" #-}+-- | The default font style.+defaultFontStyle :: FontStyle+defaultFontStyle = def++-- | Possible horizontal anchor points for text.+data HTextAnchor = HTA_Left +                 | HTA_Centre +                 | HTA_Right +                 deriving (Show, Eq, Ord)++-- | Possible vertical anchor points for text.+data VTextAnchor = VTA_Top +                 | VTA_Centre +                 | VTA_Bottom +                 | VTA_BaseLine +                 deriving (Show, Eq, Ord)++-- | Text metrics returned by 'textSize'.+data TextSize = TextSize +  { textSizeWidth    :: Double -- ^ The total width of the text.+  , textSizeAscent   :: Double -- ^ The ascent or space above the baseline.+  , textSizeDescent  :: Double -- ^ The decent or space below the baseline.+  , textSizeYBearing :: Double -- ^ The Y bearing.+  , textSizeHeight   :: Double -- ^ The total height of the text.+  } deriving (Show, Eq)++-- -----------------------------------------------------------------------+-- Fill Types+-- -----------------------------------------------------------------------++-- | Abstract data type for a fill style.+--+--   The contained Cairo action sets the required fill+--   style in the Cairo rendering state.+newtype FillStyle = FillStyleSolid +  { _fill_colour :: AlphaColour Double +  } deriving (Show, Eq)++-- | The default fill style.+instance Default FillStyle where+  def = FillStyleSolid { _fill_colour = opaque white }++-------------------------------------------------------------------------++-- | A function to align points for a certain rendering device.+type AlignmentFn = Point -> Point++-- | Holds the point and coordinate alignment function.+data AlignmentFns = AlignmentFns {+  afPointAlignFn :: AlignmentFn,+  -- ^ An adjustment applied immediately prior to points+  --   being displayed in device coordinates.+  --+  --   When device coordinates correspond to pixels, a cleaner+  --   image is created if this transform rounds to the nearest+  --   pixel. With higher-resolution output, this transform can+  --   just be the identity function.+  --   +  --   This is usually used to align prior to stroking.++  -- | A adjustment applied immediately prior to coordinates+  --   being transformed.+  --   +  --   This is usually used to align prior to filling.+  afCoordAlignFn :: AlignmentFn+  }++-- | Alignment to render good on raster based graphics.+bitmapAlignmentFns :: AlignmentFns+bitmapAlignmentFns = AlignmentFns (adjfn 0.5) (adjfn 0.0) +  where+    adjfn offset (Point x y) = Point (adj x) (adj y)+      where+        adj v = (fromIntegral.round) v +offset++-- | Alignment to render good on vector based graphics.+vectorAlignmentFns :: AlignmentFns+vectorAlignmentFns = AlignmentFns id id++$( makeLenses ''LineStyle )+$( makeLenses ''FontStyle )+

@@ -0,0 +1,465 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Drawing+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- This module contains basic types and functions used for drawing.+--+-- Note that Template Haskell is used to derive accessor functions+-- (see 'Control.Lens') for each field of the following data types:+--+--    * 'LineStyle'+--+--    * 'FontStyle'+--+-- 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 :: Control.Lens.Lens' D F+-- @+--++module Graphics.Rendering.Chart.Drawing+  ( -- * Point Types and Drawing+    PointShape(..)+  , PointStyle(..)+  , drawPoint+  , defaultPointStyle+  +  -- * Alignments and Paths+  , alignPath+  , alignFillPath+  , alignStrokePath+  , alignFillPoints+  , alignStrokePoints+  +  , alignFillPoint+  , alignStrokePoint+  +  , strokePointPath+  , fillPointPath+  +  -- * Transformation and Style Helpers+  , withRotation+  , withTranslation+  , withScale+  , withScaleX, withScaleY+  , withPointStyle+  , withDefaultStyle+  +  -- * Text Drawing+  , drawTextA+  , drawTextR+  , drawTextsR+  , textDrawRect+  , textDimension+  +  -- * Style Helpers+  , defaultColorSeq+    +  , solidLine+  , dashedLine++  , filledCircles+  , hollowCircles+  , filledPolygon+  , hollowPolygon+  , plusses+  , exes+  , stars+    +  , solidFillStyle+  +  -- * Backend and general Types+  , module Graphics.Rendering.Chart.Backend+) where++import Data.Default.Class+import Control.Lens hiding (moveTo)+import Data.Colour+import Data.Colour.SRGB+import Data.Colour.Names+import Data.List (unfoldr)+import Data.Monoid++import Control.Monad.Reader++import Graphics.Rendering.Chart.Backend+import Graphics.Rendering.Chart.Geometry++-- -----------------------------------------------------------------------+-- Transformation helpers+-- -----------------------------------------------------------------------++-- | Apply a local rotation. The angle is given in radians.+withRotation :: Double -> ChartBackend a -> ChartBackend a+withRotation angle = withTransform (rotate angle 1)++-- | Apply a local translation.+withTranslation :: Point -> ChartBackend a -> ChartBackend a+withTranslation p = withTransform (translate (pointToVec p) 1)++-- | Apply a local scale.+withScale :: Vector -> ChartBackend a -> ChartBackend a+withScale v = withTransform (scale v 1)++-- | Apply a local scale on the x-axis.+withScaleX :: Double -> ChartBackend a -> ChartBackend a+withScaleX x = withScale (Vector x 1)++-- | Apply a local scale on the y-axis.+withScaleY :: Double -> ChartBackend a -> ChartBackend a+withScaleY y = withScale (Vector 1 y)++-- | Changes the 'LineStyle' and 'FillStyle' to comply with+--   the given 'PointStyle'.+withPointStyle :: PointStyle -> ChartBackend a -> ChartBackend a+withPointStyle (PointStyle cl bcl bw _ _) m = do+  withLineStyle (def { _line_color = bcl, _line_width = bw }) $ do+    withFillStyle (solidFillStyle cl) m++withDefaultStyle :: ChartBackend a -> ChartBackend a+withDefaultStyle = withLineStyle def . withFillStyle def . withFontStyle def++-- -----------------------------------------------------------------------+-- Alignment Helpers+-- -----------------------------------------------------------------------++-- | Align the path by applying the given function on all points.+alignPath :: (Point -> Point) -> Path -> Path+alignPath f = foldPath (\p -> moveTo $ f p)+                       (\p -> lineTo $ f p)+                       (\p -> arc $ f p)+                       (\p -> arcNeg $ f p)+                       (close)++-- | Align the path using the environment's alignment function for points.+--   This is generally useful when stroking. +--   See 'alignPath' and 'getPointAlignFn'.+alignStrokePath :: Path -> ChartBackend Path+alignStrokePath p = do+  f <- getPointAlignFn+  return $ alignPath f p++-- | Align the path using the environment's alignment function for coordinates.+--   This is generally useful when filling. +--   See 'alignPath' and 'getCoordAlignFn'.+alignFillPath :: Path -> ChartBackend Path+alignFillPath p = do+  f <- getCoordAlignFn+  return $ alignPath f p++-- | The points will be aligned by the 'getPointAlignFn', so that+--   when drawing bitmaps, 1 pixel wide lines will be centred on the+--   pixels.+alignStrokePoints :: [Point] -> ChartBackend [Point]+alignStrokePoints p = do+  f <- getPointAlignFn+  return $ fmap f p++-- | The points will be aligned by the 'getCoordAlignFn', so that+--   when drawing bitmaps, the edges of the region will fall between+--   pixels.+alignFillPoints :: [Point] -> ChartBackend [Point]+alignFillPoints p = do+  f <- getCoordAlignFn+  return $ fmap f p++-- | Align the point using the environment's alignment function for points.+--   See 'getPointAlignFn'.+alignStrokePoint :: Point -> ChartBackend Point+alignStrokePoint p = do +    alignfn <- getPointAlignFn+    return (alignfn p)++-- | Align the point using the environment's alignment function for coordinates.+--   See 'getCoordAlignFn'.+alignFillPoint :: Point -> ChartBackend Point+alignFillPoint p = do +    alignfn <- getCoordAlignFn+    return (alignfn p)++-- | Create a path by connecting all points with a line.+--   The path is not closed.+stepPath :: [Point] -> Path+stepPath (p:ps) = moveTo p+               <> mconcat (map lineTo ps)+stepPath [] = mempty++-- | Draw lines between the specified points.+strokePointPath :: [Point] -> ChartBackend ()+strokePointPath pts = strokePath $ stepPath pts++-- | Fill the region with the given corners.+fillPointPath :: [Point] -> ChartBackend ()+fillPointPath pts = fillPath $ stepPath pts++-- -----------------------------------------------------------------------+-- Text Drawing+-- -----------------------------------------------------------------------++-- | Draw a line of text that is aligned at a different anchor point.+--   See 'drawText'.+drawTextA :: HTextAnchor -> VTextAnchor -> Point -> String -> ChartBackend ()+drawTextA hta vta p s = drawTextR hta vta 0 p s++-- | Draw a textual label anchored by one of its corners+--   or edges, with rotation. Rotation angle is given in degrees,+--   rotation is performed around anchor point.+--   See 'drawText'.+drawTextR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> ChartBackend ()+drawTextR hta vta angle p s =+  withTranslation p $+    withRotation theta $ do+      ts <- textSize s+      drawText (adjustText hta vta ts) s+  where+    theta = angle*pi/180.0++-- | 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.+--   See 'drawText'.+drawTextsR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> ChartBackend ()+drawTextsR hta vta angle p s = case num of+      0 -> return ()+      1 -> drawTextR hta vta angle p s+      _ -> do+        withTranslation p $+          withRotation theta $ do+            tss <- mapM textSize ss+            let ts = head tss+            let widths = map textSizeWidth tss+                maxw   = maximum widths+                maxh   = maximum (map textSizeYBearing tss)+                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 ts totalHeight))+                xs = map (adjustTextX hta) tss+            sequence_ (zipWith3 drawT xs ys ss)+    where+      ss   = lines s+      num  = length ss++      drawT x y s = drawText (Point x y) s+      theta = angle*pi/180.0++      yinit VTA_Top      ts height = textSizeAscent ts+      yinit VTA_BaseLine ts height = 0+      yinit VTA_Centre   ts height = height / 2 + textSizeAscent ts+      yinit VTA_Bottom   ts height = height + textSizeAscent ts++-- | Calculate the correct offset to align the text anchor.+adjustText :: HTextAnchor -> VTextAnchor -> TextSize -> Point+adjustText hta vta ts = Point (adjustTextX hta ts) (adjustTextY vta ts)++-- | Calculate the correct offset to align the horizontal anchor.+adjustTextX :: HTextAnchor -> TextSize -> Double+adjustTextX HTA_Left   _  = 0+adjustTextX HTA_Centre ts = (- (textSizeWidth ts / 2))+adjustTextX HTA_Right  ts = (- textSizeWidth ts)++-- | Calculate the correct offset to align the vertical anchor.+adjustTextY :: VTextAnchor -> TextSize -> Double+adjustTextY VTA_Top      ts = textSizeAscent ts+adjustTextY VTA_Centre   ts = - (textSizeYBearing ts) / 2+adjustTextY VTA_BaseLine _  = 0+adjustTextY VTA_Bottom   ts = -(textSizeDescent ts)++-- | Return the bounding rectangle for a text string positioned+--   where it would be drawn by 'drawText'.+--   See 'textSize'.+textDrawRect :: HTextAnchor -> VTextAnchor -> Point -> String -> ChartBackend Rect+textDrawRect hta vta (Point x y) s = do+  ts <- textSize s+  let (w,h) = (textSizeWidth ts, textSizeHeight ts)+  let lx = adjustTextX hta ts+  let ly = adjustTextY vta ts+  let (x',y') = (x + lx, y + ly)+  let p1 = Point x' y'+  let p2 = Point (x' + w) (y' + h)+  return $ Rect p1 p2++-- | Get the width and height of the string when rendered.+--   See 'textSize'.+textDimension :: String -> ChartBackend RectSize+textDimension s = do+  ts <- textSize s+  return (textSizeWidth ts, textSizeHeight ts)+  +-- -----------------------------------------------------------------------+-- Point Types and Drawing+-- -----------------------------------------------------------------------++-- | The different shapes a point can have.+data PointShape = PointShapeCircle           -- ^ A circle.+                | PointShapePolygon Int Bool -- ^ Number of vertices and is right-side-up?+                | PointShapePlus  -- ^ A plus sign.+                | PointShapeCross -- ^ A cross.+                | PointShapeStar  -- ^ Combination of a cross and a plus.++-- | Abstract data type for the style of a plotted point.+--+--   The contained Cairo action draws a point in the desired+--   style, at the supplied device coordinates.+data PointStyle = PointStyle +  { _point_color :: AlphaColour Double+  -- ^ The color to fill the point with.+  , _point_border_color :: AlphaColour Double+  -- ^ The color to stroke the outline with.+  , _point_border_width :: Double+  -- ^ The width of the outline.+  , _point_radius :: Double+  -- ^ The radius of the tightest surrounding circle of the point.+  , _point_shape :: PointShape+  -- ^ The shape.+  }++-- | Default style to use for points.+instance Default PointStyle where+  def = PointStyle +    { _point_color        = opaque black+    , _point_border_color = transparent+    , _point_border_width = 0+    , _point_radius       = 1+    , _point_shape        = PointShapeCircle+    }++{-# DEPRECATED defaultPointStyle "Use the according Data.Default instance!" #-}+-- | Default style for points.+defaultPointStyle :: PointStyle+defaultPointStyle = def++-- | Draw a single point at the given location.+drawPoint :: PointStyle  -- ^ Style to use when rendering the point.+          -> Point       -- ^ Position of the point to render.+          -> ChartBackend ()+drawPoint ps@(PointStyle cl bcl bw r shape) p = withPointStyle ps $ do+  p'@(Point x y) <- alignStrokePoint p+  case shape of+    PointShapeCircle -> do+      let path = arc p' r 0 (2*pi)+      fillPath path+      strokePath path+    PointShapePolygon sides isrot -> do+      let intToAngle n =+            if isrot+            then       fromIntegral n * 2*pi/fromIntegral sides+            else (0.5 + fromIntegral n)*2*pi/fromIntegral sides+          angles = map intToAngle [0 .. sides-1]+          (p:ps) = map (\a -> Point (x + r * sin a)+                                    (y + r * cos a)) angles+      let path = moveTo p <> mconcat (map lineTo ps) <> lineTo p+      fillPath path+      strokePath path+    PointShapePlus -> do+      strokePath $ moveTo' (x+r) y+                <> lineTo' (x-r) y+                <> moveTo' x (y-r)+                <> lineTo' x (y+r)+    PointShapeCross -> do+      let rad = r / sqrt 2+      strokePath $ moveTo' (x+rad) (y+rad)+                <> lineTo' (x-rad) (y-rad)+                <> moveTo' (x+rad) (y-rad)+                <> lineTo' (x-rad) (y+rad)+    PointShapeStar -> do+      let rad = r / sqrt 2+      strokePath $ moveTo' (x+r) y+                <> lineTo' (x-r) y+                <> moveTo' x (y-r)+                <> lineTo' x (y+r)+                <> moveTo' (x+rad) (y+rad)+                <> lineTo' (x-rad) (y-rad)+                <> moveTo' (x+rad) (y-rad)+                <> lineTo' (x-rad) (y+rad)++-- -----------------------------------------------------------------------+-- Style Helpers+-- -----------------------------------------------------------------------++-- | The default sequence of colours to use when plotings different data sets+--   in a graph.+defaultColorSeq :: [AlphaColour Double]+defaultColorSeq = cycle $ map opaque [blue, red, green, yellow, cyan, magenta]++-- | Create a solid line style (not dashed).+solidLine :: Double             -- ^ Width of line.+          -> AlphaColour Double -- ^ Colour of line.+          -> LineStyle+solidLine w cl = LineStyle w cl [] LineCapButt LineJoinMiter++-- | Create a dashed line style.+dashedLine :: Double   -- ^ Width of line.+           -> [Double] -- ^ The dash pattern in device coordinates.+           -> AlphaColour Double -- ^ Colour of line.+           -> LineStyle+dashedLine w ds cl = LineStyle w cl ds LineCapButt LineJoinMiter++-- | Style for filled circle points.+filledCircles :: Double             -- ^ Radius of circle.+              -> AlphaColour Double -- ^ Fill colour.+              -> PointStyle+filledCircles radius cl = +  PointStyle cl transparent 0 radius PointShapeCircle++-- | Style for stroked circle points.+hollowCircles :: Double -- ^ Radius of circle.+              -> Double -- ^ Thickness of line.+              -> AlphaColour Double -- Colour of line.+              -> PointStyle+hollowCircles radius w cl = +  PointStyle transparent cl w radius PointShapeCircle++-- | Style for stroked polygon points.+hollowPolygon :: Double -- ^ Radius of circle.+              -> Double -- ^ Thickness of line.+              -> Int    -- ^ Number of vertices.+              -> Bool   -- ^ Is right-side-up?+              -> AlphaColour Double -- ^ Colour of line.+              -> PointStyle+hollowPolygon radius w sides isrot cl = +  PointStyle transparent cl w radius (PointShapePolygon sides isrot)++-- | Style for filled polygon points.+filledPolygon :: Double -- ^ Radius of circle.+              -> Int    -- ^ Number of vertices.+              -> Bool   -- ^ Is right-side-up?+              -> AlphaColour Double -- ^ Fill color.+              -> PointStyle+filledPolygon radius sides isrot cl = +  PointStyle cl transparent 0 radius (PointShapePolygon sides isrot)++-- | Plus sign point style.+plusses :: Double -- ^ Radius of tightest surrounding circle.+        -> Double -- ^ Thickness of line.+        -> AlphaColour Double -- ^ Color of line.+        -> PointStyle+plusses radius w cl = +  PointStyle transparent cl w radius PointShapePlus++-- | Cross point style.+exes :: Double -- ^ Radius of circle.+     -> Double -- ^ Thickness of line.+     -> AlphaColour Double -- ^ Color of line.+     -> PointStyle+exes radius w cl =+  PointStyle transparent cl w radius PointShapeCross++-- | Combination of plus and cross point style.+stars :: Double -- ^ Radius of circle.+      -> Double -- ^ Thickness of line.+      -> AlphaColour Double -- ^ Color of line.+      -> PointStyle+stars radius w cl =+  PointStyle transparent cl w radius PointShapeStar++-- | Fill style that fill everything this the given colour.+solidFillStyle :: AlphaColour Double -> FillStyle+solidFillStyle cl = FillStyleSolid cl+

@@ -0,0 +1,376 @@+module Graphics.Rendering.Chart.Geometry+  ( -- * Points and Vectors+    Rect(..)+  , Point(..)+  , Vector(..)++  , RectSize+  , Range+  +  , pointToVec++  , mkrect+  , rectPath+  , pvadd+  , pvsub+  , psub+  , vscale+  , within+  , intersectRect++  , RectEdge(..)+  , Limit(..)+  , PointMapFn+  +  -- * Paths+  , Path(..)+  , lineTo, moveTo+  , lineTo', moveTo'+  , arc, arc'+  , arcNeg, arcNeg'+  , close+  +  , foldPath+  , makeLinesExplicit+  +  -- * Matrices+  , transformP, scaleP, rotateP, translateP+  , Matrix(..)+  , identity+  , rotate, scale, translate+  , scalarMultiply+  , adjoint+  , invert+  ) where++import Data.Monoid++-- | A point in two dimensions.+data Point = Point {+    p_x :: Double,+    p_y :: Double+} deriving Show++-- | A vector in two dimensions.+data Vector = Vector {+    v_x :: Double,+    v_y :: Double+} deriving Show++-- | Convert a 'Point' to a 'Vector'.+pointToVec :: Point -> Vector+pointToVec (Point x y) = Vector x y++-- | Scale a vector by a constant.+vscale :: Double -> Vector -> Vector+vscale c (Vector x y) = (Vector (x*c) (y*c))++-- | Add a point and a vector.+pvadd :: Point -> Vector -> Point+pvadd (Point x1 y1) (Vector x2 y2) = (Point (x1+x2) (y1+y2))++-- | Subtract a vector from a point.+pvsub :: Point -> Vector -> Point+pvsub (Point x1 y1) (Vector x2 y2) = (Point (x1-x2) (y1-y2))++-- | Subtract two points.+psub :: Point -> Point -> Vector+psub (Point x1 y1) (Point x2 y2) = (Vector (x1-x2) (y1-y2))++data Limit a = LMin | LValue a | LMax+   deriving Show++-- | A function mapping between points.+type PointMapFn x y = (Limit x, Limit y) -> Point++-- | A rectangle is defined by two points.+data Rect = Rect Point Point+   deriving Show++-- | Edge of a rectangle.+data RectEdge = E_Top | E_Bottom | E_Left | E_Right++-- | Create a rectangle based upon the coordinates of 4 points.+mkrect :: Point -> Point -> Point -> Point -> Rect+mkrect (Point x1 _) (Point _ y2) (Point x3 _) (Point _ y4) =+    Rect (Point x1 y2) (Point x3 y4)++-- | Test if a point is within a rectangle.+within :: Point -> Rect -> Bool+within (Point x y) (Rect (Point x1 y1) (Point x2 y2)) =+    x >= x1 && x <= x2 && y >= y1 && y <= y2++-- | Intersects the rectangles. If they intersect the+--   intersection rectangle is returned.+--   'LMin' is the empty rectangle / intersection and+--   'LMax' is the infinite plane.+intersectRect :: Limit Rect -> Limit Rect -> Limit Rect+intersectRect LMax r = r+intersectRect r LMax = r+intersectRect LMin _ = LMin+intersectRect _ LMin = LMin+intersectRect (LValue (Rect (Point x11 y11) (Point x12 y12))) +              (LValue (Rect (Point x21 y21) (Point x22 y22))) =+  let p1@(Point x1 y1) = Point (max x11 x21) (max y11 y21)+      p2@(Point x2 y2) = Point (min x12 x22) (min y12 y22)+  in if x2 < x1 || y2 < y1 +        then LMin+        else LValue $ Rect p1 p2++type Range    = (Double,Double)+type RectSize = (Double,Double)++{-+-- | Make a path from a rectangle.+rectPointPath :: Rect -> [Point]+rectPointPath (Rect p1@(Point x1 y1) p3@(Point x2 y2)) = [p1,p2,p3,p4,p1]+  where    +    p2 = (Point x1 y2)+    p4 = (Point x2 y1)+-}++-- | Make a path from a rectangle.+rectPath :: Rect -> Path+rectPath (Rect p1@(Point x1 y1) p3@(Point x2 y2)) = +  let p2 = (Point x1 y2)+      p4 = (Point x2 y1)+  in moveTo p1 <> lineTo p2 <> lineTo p3 <> lineTo p4 <> close++-- -----------------------------------------------------------------------+-- Path Types+-- -----------------------------------------------------------------------++-- | The path type used by Charts.+--   +--   A path can consist of several subpaths. Each+--   is started by a 'MoveTo' operation. All subpaths+--   are open, except the last one, which may be closed+--   using the 'Close' operation. When filling a path+--   all subpaths are closed implicitly.+--   +--   Closing a subpath means that a line is drawn from+--   the end point to the start point of the subpath.+--   +--   If a 'Arc' (or 'ArcNeg') is drawn a implicit line+--   from the last end point of the subpath is drawn+--   to the beginning of the arc. Another implicit line+--   is drawn from the end of an arc to the beginning of+--   the next path segment.+--   +--   The beginning of a subpath is either (0,0) or set+--   by a 'MoveTo' instruction. If the first subpath is started+--   with an arc the beginning of that subpath is the beginning+--   of the arc.+data Path = MoveTo Point Path +          | LineTo Point Path+          | Arc Point Double Double Double Path+          | ArcNeg Point Double Double Double Path+          | End +          | Close++-- | Paths are monoids. After a path is closed you can not append+--   anything to it anymore. The empty path is open. +--   Use 'close' to close a path.+instance Monoid Path where+  mappend p1 p2 = case p1 of+    MoveTo p path -> MoveTo p $ mappend path p2+    LineTo p path -> LineTo p $ mappend path p2+    Arc    p r a1 a2 path -> Arc p r a1 a2 $ mappend path p2+    ArcNeg p r a1 a2 path -> ArcNeg p r a1 a2 $ mappend path p2+    End   -> p2+    Close -> Close+  mempty = End++-- | Move the paths pointer to the given location.+moveTo :: Point -> Path+moveTo p = MoveTo p mempty++-- | Short-cut for 'moveTo', if you don't want to create a 'Point'.+moveTo' :: Double -> Double -> Path+moveTo' x y = moveTo $ Point x y++-- | Move the paths pointer to the given location and draw a straight +--   line while doing so.+lineTo :: Point -> Path+lineTo p = LineTo p mempty++-- | Short-cut for 'lineTo', if you don't want to create a 'Point'.+lineTo' :: Double -> Double -> Path+lineTo' x y = lineTo $ Point x y++-- | Draw the arc of a circle. A straight line connects+--   the end of the previous path with the beginning of the arc.+--   The zero angle points in direction of the positive x-axis.+--   Angles increase in clock-wise direction. If the stop angle+--   is smaller then the start angle it is increased by multiples of+--   @2 * pi@ until is is greater or equal.+arc :: Point  -- ^ Center point of the circle arc.+    -> Double -- ^ Redius of the circle.+    -> Double -- ^ Angle to start drawing at, in radians.+    -> Double -- ^ Angle to stop drawing at, in radians.+    -> Path+arc p r a1 a2 = Arc p r a1 a2 mempty++-- | Short-cut for 'arc', if you don't want to create a 'Point'.+arc' :: Double -> Double -> Double -> Double -> Double -> Path+arc' x y r a1 a2 = Arc (Point x y) r a1 a2 mempty++-- | Like 'arc', but draws from the stop angle to the start angle+--   instead of between them.+arcNeg :: Point -> Double -> Double -> Double -> Path+arcNeg p r a1 a2 = ArcNeg p r a1 a2 mempty++-- | Short-cut for 'arcNeg', if you don't want to create a 'Point'.+arcNeg' :: Double -> Double -> Double -> Double -> Double -> Path+arcNeg' x y r a1 a2 = ArcNeg (Point x y) r a1 a2 mempty++-- | A closed empty path. Closes a path when appended.+close :: Path+close = Close++-- | Fold the given path to a monoid structure.+foldPath :: (Monoid m)+         => (Point -> m) -- ^ MoveTo+         -> (Point -> m) -- ^ LineTo+         -> (Point -> Double -> Double -> Double -> m) -- ^ Arc+         -> (Point -> Double -> Double -> Double -> m) -- ^ ArcNeg+         -> m    -- ^ Close+         -> Path -- ^ Path to fold+         -> m+foldPath moveTo lineTo arc arcNeg close path = +  let restF = foldPath moveTo lineTo arc arcNeg close+  in case path of +    MoveTo p rest -> moveTo p <> restF rest+    LineTo p rest -> lineTo p <> restF rest+    Arc    p r a1 a2 rest -> arc    p r a1 a2 <> restF rest+    ArcNeg p r a1 a2 rest -> arcNeg p r a1 a2 <> restF rest+    End   -> mempty+    Close -> close++-- | Enriches the path with explicit instructions to draw lines,+--   that otherwise would be implicit. See 'Path' for details+--   about what lines in paths are implicit.+makeLinesExplicit :: Path -> Path+makeLinesExplicit (Arc c r s e rest) = +  Arc c r s e $ makeLinesExplicit' rest+makeLinesExplicit (ArcNeg c r s e rest) = +  ArcNeg c r s e $ makeLinesExplicit' rest+makeLinesExplicit path = makeLinesExplicit' path++-- | Utility for 'makeLinesExplicit'.+makeLinesExplicit' :: Path -> Path+makeLinesExplicit' End   = End+makeLinesExplicit' Close = Close+makeLinesExplicit' (Arc c r s e rest) = +  let p = translateP (pointToVec c) $ rotateP s $ Point r 0+  in lineTo p <> arc c r s e <> makeLinesExplicit' rest+makeLinesExplicit' (ArcNeg c r s e rest) = +  let p = translateP (pointToVec c) $ rotateP s $ Point r 0+  in lineTo p <> arcNeg c r s e <> makeLinesExplicit' rest+makeLinesExplicit' (MoveTo p0 rest) = +  MoveTo p0 $ makeLinesExplicit' rest+makeLinesExplicit' (LineTo p0 rest) = +  LineTo p0 $ makeLinesExplicit' rest++-- -----------------------------------------------------------------------+-- Matrix Type+-- -----------------------------------------------------------------------++-- | Transform a point using the given matrix.+transformP :: Matrix -> Point -> Point+transformP t (Point x y) = Point+  (xx t * x + xy t * y + x0 t)+  (yx t * x + yy t * y + y0 t)++-- | Rotate a point around the origin.+--   The angle is given in radians.+rotateP :: Double -> Point -> Point+rotateP a = transformP (rotate a 1)++-- | Scale a point.+scaleP :: Vector -> Point -> Point+scaleP s = transformP (scale s 1)++-- | Translate a point.+translateP :: Vector -> Point -> Point+translateP = flip pvadd++-- | Copied from Graphics.Rendering.Cairo.Matrix+data Matrix = Matrix { xx :: !Double, yx :: !Double,+                       xy :: !Double, yy :: !Double,+                       x0 :: !Double, y0 :: !Double }+                     deriving Show++-- | Copied from Graphics.Rendering.Cairo.Matrix+instance Num Matrix where+  (*) (Matrix xx yx xy yy x0 y0) (Matrix xx' yx' xy' yy' x0' y0') =+    Matrix (xx * xx' + yx * xy')+           (xx * yx' + yx * yy')+           (xy * xx' + yy * xy')+           (xy * yx' + yy * yy')+           (x0 * xx' + y0 * xy' + x0')+           (x0 * yx' + y0 * yy' + y0')++  (+) = pointwise2 (+)+  (-) = pointwise2 (-)++  negate = pointwise negate+  abs    = pointwise abs+  signum = pointwise signum+  +  fromInteger n = Matrix (fromInteger n) 0 0 (fromInteger n) 0 0++-- | Copied from Graphics.Rendering.Cairo.Matrix+{-# INLINE pointwise #-}+pointwise f (Matrix xx yx xy yy x0 y0) =+  Matrix (f xx) (f yx) (f xy) (f yy) (f x0) (f y0)++-- | Copied from Graphics.Rendering.Cairo.Matrix+{-# INLINE pointwise2 #-}+pointwise2 f (Matrix xx yx xy yy x0 y0) (Matrix xx' yx' xy' yy' x0' y0') =+  Matrix (f xx xx') (f yx yx') (f xy xy') (f yy yy') (f x0 x0') (f y0 y0')++-- | Copied from Graphics.Rendering.Cairo.Matrix+identity :: Matrix+identity = Matrix 1 0 0 1 0 0++-- | Copied and adopted from Graphics.Rendering.Cairo.Matrix+translate :: Vector -> Matrix -> Matrix+translate tv m = m * (Matrix 1 0 0 1 (v_x tv) (v_y tv))++-- | Copied and adopted from Graphics.Rendering.Cairo.Matrix+scale :: Vector -> Matrix -> Matrix+scale sv m = m * (Matrix (v_x sv) 0 0 (v_y sv) 0 0)++-- | Copied from Graphics.Rendering.Cairo.Matrix+--   Rotations angle is given in radians.+rotate :: Double -> Matrix -> Matrix+rotate r m = m * (Matrix c s (-s) c 0 0)+  where s = sin r+        c = cos r++-- | Copied from Graphics.Rendering.Cairo.Matrix+scalarMultiply :: Double -> Matrix -> Matrix+scalarMultiply scalar = pointwise (* scalar)++-- | Copied from Graphics.Rendering.Cairo.Matrix+adjoint :: Matrix -> Matrix+adjoint (Matrix a b c d tx ty) =+  Matrix d (-b) (-c) a (c*ty - d*tx) (b*tx - a*ty)++-- | Copied from Graphics.Rendering.Cairo.Matrix+invert :: Matrix -> Matrix+invert m@(Matrix xx yx xy yy _ _) = scalarMultiply (recip det) $ adjoint m+  where det = xx*yy - yx*xy++++++++++++

@@ -32,8 +32,8 @@ import Control.Monad.Trans import Numeric import Graphics.Rendering.Chart.Renderable-import Graphics.Rendering.Chart.Types-import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing  import Data.Colour import Data.Colour.Names@@ -224,9 +224,9 @@ ---------------------------------------------------------------------- type DArray = Array Int Double -getSizes :: Grid (Renderable a) -> CRender (DArray, DArray, DArray, DArray)+getSizes :: Grid (Renderable a) -> ChartBackend (DArray, DArray, DArray, DArray) getSizes t = do-    szs <- mapGridM minsize t :: CRender (Grid RectSize)+    szs <- mapGridM minsize t :: ChartBackend (Grid RectSize)     let szs'     = flatten szs     let widths   = accumArray max 0 (0, width  t - 1)                                                    (foldT (ef wf  fst) [] szs')@@ -247,12 +247,12 @@                                    | otherwise    = r  instance (ToRenderable a) => ToRenderable (Grid a) where-    toRenderable = gridToRenderable . fmap toRenderable+  toRenderable = gridToRenderable . fmap toRenderable  gridToRenderable :: Grid (Renderable a) -> Renderable a gridToRenderable t = Renderable minsizef renderf   where-    minsizef :: CRender RectSize+    minsizef :: ChartBackend RectSize     minsizef = do         (widths, heights, xweights, yweights) <- getSizes t         return (sum (elems widths), sum (elems heights))@@ -270,12 +270,11 @@         Empty -> return nullPickFn         (Value (r,span,_)) -> do             let (Rect p0 p1) = mkRect borders loc span-            p0'@(Point x0 y0) <- alignc p0-            p1'@(Point x1 y1) <- alignc p1-            preserveCState $ do-                c $ C.translate x0 y0-                pf <- render r (x1-x0,y1-y0)-                return (newpf pf x0 y0)+            p0'@(Point x0 y0) <- alignFillPoint p0+            p1'@(Point x1 y1) <- alignFillPoint p1+            withTranslation (Point x0 y0) $ do+              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

@@ -7,8 +7,8 @@ -- This module glues together axes and plots to actually create a renderable -- for a chart. ----- Note that template haskell is used to derive accessor functions--- (see 'Data.Accessor') for each field of the following data types:+-- Note that Template haskell is used to derive accessor functions+-- (see 'Control.Lens') for each field of the following data types: -- --     * 'Layout1' -- @@ -21,11 +21,12 @@ -- dropped. Hence for data field f_::F in type D, they have type -- -- @---   f :: Data.Accessor.Accessor D F+--   f :: Control.Lens.Lens' D F -- @ ----{-# OPTIONS_GHC -XTemplateHaskell -XExistentialQuantification #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ExistentialQuantification #-}  module Graphics.Rendering.Chart.Layout(     Layout1(..),@@ -74,45 +75,45 @@     renderStackedLayouts,   ) where -import qualified Graphics.Rendering.Cairo as C- import Graphics.Rendering.Chart.Axis-import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing+import Graphics.Rendering.Chart.Utils import Graphics.Rendering.Chart.Plot import Graphics.Rendering.Chart.Legend import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Grid import Control.Monad import Control.Monad.Reader (local)-import Data.Accessor.Template-import Data.Accessor+import Control.Lens import Data.Colour import Data.Colour.Names (white)+import Data.Default.Class  -- | A @MAxisFn@ is a function that generates an (optional) axis --   given the points plotted against that axis. type MAxisFn t = [t] -> Maybe (AxisData t)  data LayoutAxis x = LayoutAxis {-   laxis_title_style_ :: CairoFontStyle,-   laxis_title_       :: String,-   laxis_style_       :: AxisStyle,+   _laxis_title_style :: FontStyle,+   _laxis_title       :: String,+   _laxis_style       :: AxisStyle,     -- | Function that determines whether an axis should be visible,    --   based upon the points plotted on this axis. The default value    --   is 'not.null'.-   laxis_visible_     :: [x] -> Bool,+   _laxis_visible     :: [x] -> Bool,     -- | Function that generates the axis data, based upon the    --   points plotted. The default value is 'autoAxis'.-   laxis_generate_    :: AxisFn x,+   _laxis_generate    :: AxisFn x,     -- | Function that can be used to override the generated axis data.    --   The default value is 'id'.-   laxis_override_    :: AxisData x -> AxisData x,+   _laxis_override    :: AxisData x -> AxisData x,     -- | True if left to right (bottom to top) is to show descending values.-   laxis_reverse_     :: Bool+   _laxis_reverse     :: Bool  } @@ -122,29 +123,32 @@ --   and vertical axes. data Layout1 x y = Layout1 { -    layout1_background_      :: CairoFillStyle,-    layout1_plot_background_ :: Maybe CairoFillStyle,+    _layout1_background      :: FillStyle,+    _layout1_plot_background :: Maybe FillStyle, -    layout1_title_           :: String,-    layout1_title_style_     :: CairoFontStyle,+    _layout1_title           :: String,+    _layout1_title_style     :: FontStyle, -    layout1_bottom_axis_     :: LayoutAxis x,-    layout1_top_axis_        :: LayoutAxis x,-    layout1_left_axis_       :: LayoutAxis y,-    layout1_right_axis_      :: LayoutAxis y,+    _layout1_bottom_axis     :: LayoutAxis x,+    _layout1_top_axis        :: LayoutAxis x,+    _layout1_left_axis       :: LayoutAxis y,+    _layout1_right_axis      :: LayoutAxis y,      -- | Function to map points from the left/right plot     --   to the left/right axes. The default value is 'id'.-    layout1_yaxes_control_   :: ([y],[y]) -> ([y],[y]),+    _layout1_yaxes_control   :: ([y],[y]) -> ([y],[y]), -    layout1_margin_          :: Double,-    layout1_plots_           :: [Either (Plot x y) (Plot x y)],-    layout1_legend_          :: Maybe LegendStyle,+    _layout1_margin          :: Double,+    _layout1_plots           :: [Either (Plot x y) (Plot x y)],+    _layout1_legend          :: Maybe LegendStyle,      -- | True if the grid is to be rendered on top of the Plots.-    layout1_grid_last_       :: Bool+    _layout1_grid_last       :: Bool } +instance (Ord x, Ord y) => ToRenderable (Layout1 x y) where+  toRenderable = setPickFn nullPickFn . layout1ToRenderable+ data Layout1Pick x y = L1P_Legend String                      | L1P_Title String                      | L1P_BottomAxisTitle String@@ -158,25 +162,26 @@                      | L1P_RightAxis y     deriving (Show) -instance (Ord x, Ord y) => ToRenderable (Layout1 x y) where-    toRenderable = setPickFn nullPickFn.layout1ToRenderable--type LegendItem = (String,Rect -> CRender ())+type LegendItem = (String,Rect -> ChartBackend ()) --- | A layout with it's y type hidded, so that it can be stacked+-- | A layout with its y type hidden, so that it can be stacked -- with other layouts (with differing y types) data StackedLayout x = forall y . Ord y => StackedLayout (Layout1 x y) --- | A holder for a set of vertically stacked layouts+-- | A container for a set of vertically stacked layouts data StackedLayouts x = StackedLayouts {-      slayouts_layouts_ :: [StackedLayout x],-      slayouts_compress_xlabels_ :: Bool,-      slayouts_compress_legend_ :: Bool+      _slayouts_layouts :: [StackedLayout x],+      _slayouts_compress_xlabels :: Bool,+      _slayouts_compress_legend :: Bool } +{-# DEPRECATED defaultStackedLayouts  "Use the according Data.Default instance!" #-} defaultStackedLayouts :: StackedLayouts x-defaultStackedLayouts = StackedLayouts [] True True+defaultStackedLayouts = def +instance Default (StackedLayouts x) where+  def = StackedLayouts [] True True+ -- | Render several layouts with the same x-axis type and range, --   vertically stacked so that their origins and x-values are aligned. --@@ -184,8 +189,8 @@ -- once on the bottom chart.   The x labels may be optionally removed so that -- they are only shown once. renderStackedLayouts :: (Ord x) => StackedLayouts x -> Renderable ()-renderStackedLayouts (StackedLayouts{slayouts_layouts_=[]}) = emptyRenderable-renderStackedLayouts slp@(StackedLayouts{slayouts_layouts_=sls@(sl1:_)}) = gridToRenderable g+renderStackedLayouts (StackedLayouts{_slayouts_layouts=[]}) = emptyRenderable+renderStackedLayouts slp@(StackedLayouts{_slayouts_layouts=sls@(sl1:_)}) = gridToRenderable g   where     g = fullOverlayUnder (fillBackground bg emptyRenderable)       $ foldr (above.mkGrid) nullt (zip sls [0,1..])@@ -198,30 +203,30 @@           (if showLegend then noPickFn $ renderLegend l legenditems else emptyRenderable)        where-        legenditems = case (slayouts_compress_legend_ slp,isBottomPlot) of+        legenditems = case (_slayouts_compress_legend slp,isBottomPlot) of             (False,_) -> getLegendItems l             (True,True) -> alllegendItems             (True,False) -> ([],[])          mkPlotArea bx tx = fmap (mapPickFn (const ()))-                         $ layout1PlotAreaToGrid l{layout1_bottom_axis_=bx,layout1_top_axis_=tx}+                         $ layout1PlotAreaToGrid l{_layout1_bottom_axis=bx,_layout1_top_axis=tx}          showLegend = not (null (fst legenditems)) || not (null (snd legenditems))          isTopPlot = i == 0         isBottomPlot = i == length sls -1 -        lm = layout1_margin_ l+        lm = _layout1_margin l -        baxis = mkAxis (layout1_bottom_axis_ l) (isBottomPlot || not (slayouts_compress_xlabels_ slp))-        taxis = mkAxis (layout1_top_axis_ l) (isTopPlot || not (slayouts_compress_xlabels_ slp))+        baxis = mkAxis (_layout1_bottom_axis l) (isBottomPlot || not (_slayouts_compress_xlabels slp))+        taxis = mkAxis (_layout1_top_axis l) (isTopPlot || not (_slayouts_compress_xlabels slp))          mkAxis a showLabels = a{-            laxis_generate_=const (laxis_generate_ a all_xvals),-            laxis_override_= if showLabels then id else \ad -> ad{axis_labels_=[]}+            _laxis_generate=const (_laxis_generate a all_xvals),+            _laxis_override= if showLabels then id else \ad -> ad{_axis_labels=[]}         } -    bg = (\(StackedLayout l) -> layout1_background_ l) sl1+    bg = (\(StackedLayout l) -> _layout1_background l) sl1          all_xvals = concatMap (\(StackedLayout l) -> getLayout1XVals l) sls @@ -232,7 +237,7 @@     noPickFn = mapPickFn (const ())  addMarginsToGrid :: (Double,Double,Double,Double) -> Grid (Renderable a)-                    -> Grid (Renderable a)+                 -> Grid (Renderable a) addMarginsToGrid (t,b,l,r) g = aboveN [      besideN [er, ts, er],      besideN [ls, g,  rs],@@ -247,8 +252,8 @@  layout1ToRenderable :: (Ord x, Ord y) =>                        Layout1 x y -> Renderable (Layout1Pick x y)-layout1ToRenderable l =-   fillBackground (layout1_background_ l) $ gridToRenderable (layout1ToGrid l)+layout1ToRenderable l = +  fillBackground (_layout1_background l) $ gridToRenderable (layout1ToGrid l)  layout1ToGrid :: (Ord x, Ord y) =>                  Layout1 x y -> Grid (Renderable (Layout1Pick x y))@@ -259,20 +264,20 @@        ,  tval $ layout1LegendsToRenderable l        ]   where-    lm = layout1_margin_ l+    lm = _layout1_margin l  layout1TitleToRenderable :: (Ord x, Ord y) => Layout1 x y                                            -> Renderable (Layout1Pick x y)-layout1TitleToRenderable l | null (layout1_title_ l) = emptyRenderable+layout1TitleToRenderable l | 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)-    lm    = layout1_margin_ l+    title = label (_layout1_title_style l) HTA_Centre VTA_Centre+                  (_layout1_title l)+    lm    = _layout1_margin l  getLayout1XVals :: Layout1 x y -> [x]-getLayout1XVals l = concatMap (fst.plot_all_points_.deEither) (layout1_plots_ l)+getLayout1XVals l = concatMap (fst._plot_all_points.deEither) (_layout1_plots l)   where     deEither (Left x)  = x     deEither (Right x) = x@@ -280,8 +285,8 @@  getLegendItems :: Layout1 x y -> ([LegendItem],[LegendItem]) getLegendItems l = (-    concat [ plot_legend_ p | (Left p ) <- (layout1_plots_ l) ],-    concat [ plot_legend_ p | (Right p) <- (layout1_plots_ l) ]+    concat [ _plot_legend p | (Left p ) <- (_layout1_plots l) ],+    concat [ _plot_legend p | (Right p) <- (_layout1_plots l) ]     )  renderLegend :: Layout1 x y -> ([LegendItem],[LegendItem]) -> Renderable (Layout1Pick x y)@@ -291,9 +296,9 @@                      , weights (1,1) $ tval $ emptyRenderable                      , tval $ mkLegend rights ] -    lm     = layout1_margin_ l+    lm     = _layout1_margin l -    mkLegend vals = case (layout1_legend_ l) of+    mkLegend vals = case (_layout1_legend l) of         Nothing -> emptyRenderable         Just ls ->  case filter ((/="").fst) vals of             []  -> emptyRenderable ;@@ -304,7 +309,7 @@                               Layout1 x y -> Renderable (Layout1Pick x y) layout1LegendsToRenderable l = renderLegend l (getLegendItems l) -layout1PlotAreaToGrid :: (Ord x, Ord y) =>+layout1PlotAreaToGrid :: forall x y. (Ord x, Ord y) =>                           Layout1 x y -> Grid (Renderable (Layout1Pick x y)) layout1PlotAreaToGrid l = layer2 `overlay` layer1   where@@ -321,22 +326,27 @@          , besideN [er,     er,  bl,    baxis,  br,    er,  er       ]          , besideN [er,     er,  er,    btitle, er,    er,  er       ]          ]--    (ttitle,_) = atitle HTA_Centre VTA_Bottom   0 layout1_top_axis_    L1P_TopAxisTitle-    (btitle,_) = atitle HTA_Centre VTA_Top      0 layout1_bottom_axis_ L1P_BottomAxisTitle-    (ltitle,lam) = atitle HTA_Right  VTA_Centre 270 layout1_left_axis_   L1P_LeftAxisTitle-    (rtitle,ram) = atitle HTA_Left   VTA_Centre 270 layout1_right_axis_  L1P_RightAxisTitle+    +    (ttitle,_) = atitle HTA_Centre VTA_Bottom   0 _layout1_top_axis    L1P_TopAxisTitle   +    (btitle,_) = atitle HTA_Centre VTA_Top      0 _layout1_bottom_axis L1P_BottomAxisTitle+    (ltitle,lam) = atitle HTA_Right  VTA_Centre 270 _layout1_left_axis   L1P_LeftAxisTitle+    (rtitle,ram) = atitle HTA_Left   VTA_Centre 270 _layout1_right_axis  L1P_RightAxisTitle      er = tval $ emptyRenderable-+    +    atitle :: HTextAnchor -> VTextAnchor +            -> Double +            -> (Layout1 x y -> LayoutAxis z) +            -> (String -> Layout1Pick x y) +            -> (Grid (Renderable (Layout1Pick x y)), Grid (Renderable (Layout1Pick x y)))     atitle ha va rot af pf = if ttext == "" then (er,er) else (label,gap)       where         label = tval $ mapPickFn pf $ rlabel tstyle ha va rot ttext-        gap = tval $ spacer (layout1_margin_ l,0)-        tstyle = laxis_title_style_ (af l)-        ttext  = laxis_title_       (af l)+        gap = tval $ spacer (_layout1_margin l,0)+        tstyle = _laxis_title_style (af l)+        ttext  = _laxis_title       (af l) -    plots = tval $ mfill (layout1_plot_background_ l) $ plotsToRenderable l+    plots = tval $ mfill (_layout1_plot_background l) $ plotsToRenderable l       where         mfill Nothing   = id         mfill (Just fs) = fillBackground fs@@ -362,14 +372,12 @@         render  = renderPlots l     } -renderPlots :: Layout1 x y -> RectSize -> CRender (PickFn (Layout1Pick x y))+renderPlots :: Layout1 x y -> RectSize -> ChartBackend (PickFn (Layout1Pick x y)) renderPlots l sz@(w,h) = do-    when (not (layout1_grid_last_ l)) renderGrids-    preserveCState $ do-        -- render the plots-        setClipRegion (Point 0 0) (Point w h)-        mapM_ rPlot (layout1_plots_ l)-    when (layout1_grid_last_ l) renderGrids+    when (not (_layout1_grid_last l)) renderGrids+    withClipRegion (Rect (Point 0 0) (Point w h)) $ do+      mapM_ rPlot (_layout1_plots l)+    when (_layout1_grid_last l) renderGrids     return pickfn    where@@ -387,12 +395,12 @@           xr1 = reverse xrev xr           yr1 = reverse yrev yr           yrange = if yrev then (0, h) else (h, 0)-          pmfn (x,y) = Point (mapv xr1 (axis_viewport_ xaxis xr1) x)-                             (mapv yr1 (axis_viewport_ yaxis yr1) y)+          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+	  in _plot_render p pmfn     rPlot1 _ _ _ = return ()      pickfn (Point x y) = do  -- Maybe monad@@ -409,8 +417,8 @@             (Nothing,Just at)   -> Just (at,at)             (Just at1,Just at2) -> Just (at1,at2)             (Nothing,Nothing)   -> Nothing-        mapx (AxisT _ _ rev ad) x = axis_tropweiv_ ad (reverse rev xr) x-        mapy (AxisT _ _ rev ad) y = axis_tropweiv_ ad (reverse rev yr) y+        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@@ -427,86 +435,94 @@            (Maybe (AxisT x), Maybe (AxisT y), Maybe (AxisT x), Maybe (AxisT y)) getAxes l = (bAxis,lAxis,tAxis,rAxis)   where-    (xvals0,xvals1,yvals0,yvals1) = allPlottedValues (layout1_plots_ l)+    (xvals0,xvals1,yvals0,yvals1) = allPlottedValues (_layout1_plots l)     xvals                         = xvals0 ++ xvals1-    (yvals0',yvals1')             = layout1_yaxes_control_ l (yvals0,yvals1)+    (yvals0',yvals1')             = _layout1_yaxes_control l (yvals0,yvals1) -    bAxis = mkAxis E_Bottom (layout1_bottom_axis_ l) xvals-    tAxis = mkAxis E_Top    (layout1_top_axis_ l)    xvals-    lAxis = mkAxis E_Left   (layout1_left_axis_ l)  yvals0'-    rAxis = mkAxis E_Right  (layout1_right_axis_ l) yvals1'+    bAxis = mkAxis E_Bottom (_layout1_bottom_axis l) xvals+    tAxis = mkAxis E_Top    (_layout1_top_axis l)    xvals+    lAxis = mkAxis E_Left   (_layout1_left_axis l)  yvals0'+    rAxis = mkAxis E_Right  (_layout1_right_axis l) yvals1' -    mkAxis t laxis vals = case laxis_visible_ laxis vals of+    mkAxis t laxis vals = case _laxis_visible laxis vals of         False -> Nothing         True  -> Just (AxisT t style rev adata)       where-        style = laxis_style_ laxis-        rev   = laxis_reverse_ laxis-        adata = (laxis_override_ laxis) (laxis_generate_ laxis vals)+        style = _laxis_style laxis+        rev   = _laxis_reverse laxis+        adata = (_laxis_override laxis) (_laxis_generate laxis vals)  allPlottedValues :: [(Either (Plot x y) (Plot x' y'))]                     -> ( [x], [x'], [y], [y'] ) allPlottedValues plots = (xvals0,xvals1,yvals0,yvals1)   where-    xvals0 = [ x | (Left p)  <- plots, x <- fst $ plot_all_points_ p]-    yvals0 = [ y | (Left p)  <- plots, y <- snd $ plot_all_points_ p]-    xvals1 = [ x | (Right p) <- plots, x <- fst $ plot_all_points_ p]-    yvals1 = [ y | (Right p) <- plots, y <- snd $ plot_all_points_ p]+    xvals0 = [ x | (Left p)  <- plots, x <- fst $ _plot_all_points p]+    yvals0 = [ y | (Left p)  <- plots, y <- snd $ _plot_all_points p]+    xvals1 = [ x | (Right p) <- plots, x <- fst $ _plot_all_points p]+    yvals1 = [ y | (Right p) <- plots, y <- snd $ _plot_all_points p] +{-# DEPRECATED defaultLayout1  "Use the according Data.Default instance!" #-} defaultLayout1 :: (PlotValue x,PlotValue y) => Layout1 x y-defaultLayout1 = Layout1 {-    layout1_background_      = solidFillStyle $ opaque white,-    layout1_plot_background_ = Nothing,+defaultLayout1 = def -    layout1_title_           = "",-    layout1_title_style_     = defaultFontStyle{font_size_   =15-                                               ,font_weight_ =C.FontWeightBold},+instance (PlotValue x, PlotValue y) => Default (Layout1 x y) where+  def = Layout1 +    { _layout1_background      = solidFillStyle $ opaque white+    , _layout1_plot_background = Nothing -    layout1_top_axis_        = defaultLayoutAxis {laxis_visible_ = const False},-    layout1_bottom_axis_     = defaultLayoutAxis,-    layout1_left_axis_       = defaultLayoutAxis,-    layout1_right_axis_      = defaultLayoutAxis,+    , _layout1_title           = ""+    , _layout1_title_style     = def { _font_size   = 15+                                     , _font_weight = FontWeightBold } -    layout1_yaxes_control_   = id,+    , _layout1_top_axis        = def {_laxis_visible = const False}+    , _layout1_bottom_axis     = def+    , _layout1_left_axis       = def+    , _layout1_right_axis      = def -    layout1_margin_          = 10,-    layout1_plots_           = [],-    layout1_legend_          = Just defaultLegendStyle,-    layout1_grid_last_       = False-}+    , _layout1_yaxes_control   = id +    , _layout1_margin          = 10+    , _layout1_plots           = []+    , _layout1_legend          = Just def+    , _layout1_grid_last       = False+    }++{-# DEPRECATED defaultLayoutAxis "Use the according Data.Default instance!" #-} defaultLayoutAxis :: PlotValue t => LayoutAxis t-defaultLayoutAxis = LayoutAxis {-   laxis_title_style_ = defaultFontStyle{font_size_=10},-   laxis_title_       = "",-   laxis_style_       = defaultAxisStyle,-   laxis_visible_     = not.null,-   laxis_generate_    = autoAxis,-   laxis_override_    = id,-   laxis_reverse_     = False-}+defaultLayoutAxis = def +instance PlotValue t => Default (LayoutAxis t) where+  def = LayoutAxis+    { _laxis_title_style = def { _font_size=10 }+    , _laxis_title       = ""+    , _laxis_style       = def+    , _laxis_visible     = not.null+    , _laxis_generate    = autoAxis+    , _laxis_override    = id+    , _laxis_reverse     = False+    }+ ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field.-$( deriveAccessors ''Layout1 )-$( deriveAccessors ''LayoutAxis )-$( deriveAccessors ''StackedLayouts )+$( makeLenses ''Layout1 )+$( makeLenses ''LayoutAxis )+$( makeLenses ''StackedLayouts )  -- | Helper to update all axis styles on a Layout1 simultaneously. updateAllAxesStyles :: (AxisStyle -> AxisStyle) -> Layout1 x y -> Layout1 x y-updateAllAxesStyles uf = (layout1_top_axis    .> laxis_style ^: uf) .-                         (layout1_bottom_axis .> laxis_style ^: uf) .-                         (layout1_left_axis   .> laxis_style ^: uf) .-                         (layout1_right_axis  .> laxis_style ^: uf)+updateAllAxesStyles uf = (layout1_top_axis    . laxis_style %~ uf) .+                         (layout1_bottom_axis . laxis_style %~ uf) .+                         (layout1_left_axis   . laxis_style %~ uf) .+                         (layout1_right_axis  . laxis_style %~ uf)  -- | Helper to set the forground color uniformly on a Layout1. setLayout1Foreground :: AlphaColour Double -> Layout1 x y -> Layout1 x y setLayout1Foreground fg =-    updateAllAxesStyles  ( (axis_line_style  .> line_color ^= fg)-                         . (axis_label_style .> font_color ^= fg))-    . (layout1_title_style .> font_color ^= fg)-    . (layout1_legend ^: fmap (legend_label_style .> font_color ^= fg))+    updateAllAxesStyles  ( (axis_line_style  . line_color .~ fg)+                         . (axis_label_style . font_color .~ fg))+    . (layout1_title_style . font_color .~ fg)+    . (layout1_legend %~ fmap (legend_label_style .> font_color .~ fg))   linkAxes :: ([a], [a]) -> ([a], [a])

@@ -6,8 +6,7 @@ --  -- 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 #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Legend(     Legend(..),@@ -21,12 +20,13 @@     legend_orientation ) where -import qualified Graphics.Rendering.Cairo as C import Control.Monad import Data.List (nub, partition,intersperse)-import Data.Accessor.Template+import Control.Lens+import Data.Default.Class -import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Plot.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Grid@@ -35,10 +35,10 @@ -- Legend  data LegendStyle = LegendStyle {-   legend_label_style_ :: CairoFontStyle,-   legend_margin_      :: Double,-   legend_plot_size_   :: Double,-   legend_orientation_ :: LegendOrientation+   _legend_label_style :: FontStyle,+   _legend_margin      :: Double,+   _legend_plot_size   :: Double,+   _legend_orientation :: LegendOrientation }  -- | Legends can be constructed in two orientations: in rows@@ -48,15 +48,15 @@                        | LOCols Int                         -data Legend x y = Legend LegendStyle [(String, Rect -> CRender ())]+data Legend x y = Legend LegendStyle [(String, Rect -> ChartBackend ())]  instance ToRenderable (Legend x y) where-  toRenderable = setPickFn nullPickFn.legendToRenderable+  toRenderable = setPickFn nullPickFn . legendToRenderable  legendToRenderable :: Legend x y -> Renderable String legendToRenderable (Legend ls lvs) = gridToRenderable grid   where-    grid = case legend_orientation_ ls of+    grid = case _legend_orientation ls of         LORows n -> mkGrid n aboveG besideG         LOCols n -> mkGrid n besideG aboveG  @@ -65,7 +65,7 @@      mkGrid n join1 join2 = join1 [ join2 (map rf ps1) | ps1 <- groups n ps ] -    ps  :: [(String, [Rect -> CRender ()])]+    ps  :: [(String, [Rect -> ChartBackend ()])]     ps   = join_nub lvs      rf (title,rfs) = besideN [gpic,ggap2,gtitle]@@ -73,15 +73,15 @@         gpic = besideN $ intersperse ggap2 (map rp rfs)         gtitle = tval $ lbl title         rp rfn = tval $ Renderable {-                     minsize = return (legend_plot_size_ ls, 0),+                     minsize = return (_legend_plot_size ls, 0),                      render  = \(w,h) -> do                           rfn (Rect (Point 0 0) (Point w h))                          return (\_-> Just title)                  } -    ggap1 = tval $ spacer (legend_margin_ ls,legend_margin_ ls / 2)+    ggap1 = tval $ spacer (_legend_margin ls,_legend_margin ls / 2)     ggap2 = tval $ spacer1 (lbl "X")-    lbl s = label (legend_label_style_ ls) HTA_Left VTA_Centre s+    lbl s = label (_legend_label_style ls) HTA_Left VTA_Centre s  groups :: Int -> [a] -> [[a]] groups  n [] = []@@ -92,16 +92,17 @@                          (xs, rest) -> (x, a1:map snd xs) : join_nub rest join_nub []          = [] +{-# DEPRECATED defaultLegendStyle  "Use the according Data.Default instance!" #-} defaultLegendStyle :: LegendStyle-defaultLegendStyle = LegendStyle {-    legend_label_style_ = defaultFontStyle,-    legend_margin_      = 20,-    legend_plot_size_   = 20,-    legend_orientation_ = LORows 4-}+defaultLegendStyle = def -------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor--- for each field.-$( deriveAccessors ''LegendStyle )+instance Default LegendStyle where+  def = LegendStyle +    { _legend_label_style = def+    , _legend_margin      = 20+    , _legend_plot_size   = 20+    , _legend_orientation = LORows 4+    }++$( makeLenses ''LegendStyle ) 

@@ -7,9 +7,6 @@ -- Code to calculate and render various types of plots. -- -{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -XTemplateHaskell #-}- module Graphics.Rendering.Chart.Plot(     module Graphics.Rendering.Chart.Plot.Types,     module Graphics.Rendering.Chart.Plot.Lines,

@@ -6,7 +6,7 @@ -- -- Show textual annotations on a chart. -{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.Annotation(     PlotAnnotation(..),@@ -19,62 +19,62 @@     plot_annotation_values ) where -import Data.Accessor.Template-import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types+import Control.Lens+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing 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)+import Data.Default.Class+ -- | 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)]+      _plot_annotation_hanchor :: HTextAnchor,+      _plot_annotation_vanchor :: VTextAnchor,+      _plot_annotation_angle   :: Double,+      _plot_annotation_style   :: FontStyle,+      _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)+        _plot_render = renderAnnotation p,+	_plot_legend = [],+	_plot_all_points = (map (\(x,_,_)->x)  vs , map (\(_,y,_)->y) vs)     }       where-        vs = plot_annotation_values_ p+        vs = _plot_annotation_values p  -renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> CRender ()--renderAnnotation p pMap = preserveCState $ do-                            setFontStyle style                            +renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> ChartBackend ()+renderAnnotation p pMap = withFontStyle style $ do                                                        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+    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.+{-# DEPRECATED defaultPlotAnnotation  "Use the according Data.Default instance!" #-}+defaultPlotAnnotation :: PlotAnnotation x y+defaultPlotAnnotation = def -$( deriveAccessors ''PlotAnnotation )+instance Default (PlotAnnotation x y) where+  def = PlotAnnotation +    { _plot_annotation_hanchor = HTA_Centre+    , _plot_annotation_vanchor = VTA_Centre+    , _plot_annotation_angle   = 0+    , _plot_annotation_style   = def+    , _plot_annotation_values  = []+    } +$( makeLenses ''PlotAnnotation )

@@ -7,7 +7,7 @@ -- with x,y position, and an independent z value to be represented -- by the relative area of the spots. -{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.AreaSpots   ( AreaSpots(..)@@ -30,14 +30,14 @@   , area_spots_4d_values   ) where -import qualified Graphics.Rendering.Cairo as C--import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Plot.Types import Graphics.Rendering.Chart.Axis-import Data.Accessor.Template+import Control.Lens import Data.Colour import Data.Colour.Names+import Data.Default.Class  import Control.Monad @@ -56,49 +56,52 @@ -- | 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_ :: Colour Double-  , area_spots_opacity_    :: Double-  , area_spots_max_radius_ :: Double	-- ^ the largest size of spot-  , area_spots_values_     :: [(x,y,z)]+  { _area_spots_title      :: String+  , _area_spots_linethick  :: Double+  , _area_spots_linecolour :: AlphaColour Double+  , _area_spots_fillcolour :: Colour Double+  , _area_spots_opacity    :: Double+  , _area_spots_max_radius :: Double	-- ^ the largest size of spot+  , _area_spots_values     :: [(x,y,z)]   } +{-# DEPRECATED defaultAreaSpots "Use the according Data.Default instance!" #-} defaultAreaSpots :: AreaSpots z x y-defaultAreaSpots = AreaSpots-  { area_spots_title_      = ""-  , area_spots_linethick_  = 0.1-  , area_spots_linecolour_ = opaque blue-  , area_spots_fillcolour_ = blue-  , area_spots_opacity_    = 0.2-  , area_spots_max_radius_ = 20  -- in pixels-  , area_spots_values_     = []-  }+defaultAreaSpots = def +instance Default (AreaSpots z x y) where+  def = AreaSpots+    { _area_spots_title      = ""+    , _area_spots_linethick  = 0.1+    , _area_spots_linecolour = opaque blue+    , _area_spots_fillcolour = blue+    , _area_spots_opacity    = 0.2+    , _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) )+    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))+renderAreaSpots  :: (PlotValue z) => AreaSpots z x y -> PointMapFn x y -> ChartBackend ()+renderAreaSpots p pmap = +    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 $+              let psSpot = filledCircles radius $                                                     flip withOpacity -                                                      (area_spots_opacity_ p) $-                                                    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))+                                                      (_area_spots_opacity p) $+                                                    _area_spots_fillcolour p+              drawPoint psSpot (pmap (LValue x, LValue y))+              let psOutline = hollowCircles radius+                                                      (_area_spots_linethick p)+                                                      (_area_spots_linecolour p)+              drawPoint psOutline (pmap (LValue x, LValue y))           )   where     scaleMax :: PlotValue z => Double -> [(x,y,z)] -> [(x,y,Double)]@@ -106,19 +109,19 @@                             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+renderSpotLegend :: AreaSpots z x y -> Rect -> ChartBackend ()+renderSpotLegend p r@(Rect p1 p2) = 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 $+    let psSpot    = filledCircles radius $                                           flip withOpacity -                                               (area_spots_opacity_ p) $-                                          area_spots_fillcolour_ p-    drawSpotAt centre-    let (CairoPointStyle drawOutlineAt) = hollowCircles radius-                                            (area_spots_linethick_ p)-                                            (area_spots_linecolour_ p)-    drawOutlineAt centre+                                               (_area_spots_opacity p) $+                                          _area_spots_fillcolour p+    drawPoint psSpot centre+    let psSpot = hollowCircles radius+                                            (_area_spots_linethick p)+                                            (_area_spots_linecolour p)+    drawPoint psSpot centre   where     linearInterpolate (Point x0 y0) (Point x1 y1) =         Point (x0 + abs(x1-x0)/2) (y0 + abs(y1-y0)/2)@@ -129,49 +132,53 @@ --   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_opacity_    :: Double-  , area_spots_4d_max_radius_ :: Double	-- ^ the largest size of spot-  , area_spots_4d_values_     :: [(x,y,z,t)]+  { _area_spots_4d_title      :: String+  , _area_spots_4d_linethick  :: Double+  , _area_spots_4d_palette    :: [Colour Double]+  , _area_spots_4d_opacity    :: Double+  , _area_spots_4d_max_radius :: Double	-- ^ the largest size of spot+  , _area_spots_4d_values     :: [(x,y,z,t)]   } +{-# DEPRECATED defaultAreaSpots4D "Use the according Data.Default instance!" #-} 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_opacity_    = 0.2-  , area_spots_4d_max_radius_ = 20  -- in pixels-  , area_spots_4d_values_     = []-  }+defaultAreaSpots4D = def +instance Default (AreaSpots4D z t x y) where+  def = AreaSpots4D+    { _area_spots_4d_title      = ""+    , _area_spots_4d_linethick  = 0.1+    , _area_spots_4d_palette    = [ blue, green, yellow, orange, red ]+    , _area_spots_4d_opacity    = 0.2+    , _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+    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) )+                    , _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))+                      AreaSpots4D z t x y -> PointMapFn x y -> ChartBackend ()+renderAreaSpots4D p pmap = +    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)+              let colour  = (_area_spots_4d_palette p) !! t +              let psSpot                     = filledCircles radius $-                          flip withOpacity (area_spots_4d_opacity_ p) $ colour-              drawSpotAt (pmap (LValue x, LValue y))-              let (CairoPointStyle drawOutlineAt)-                    = hollowCircles radius (area_spots_4d_linethick_ p)+                          flip withOpacity (_area_spots_4d_opacity p) $ colour+              drawPoint psSpot (pmap (LValue x, LValue y))+              let psOutline+                    = hollowCircles radius (_area_spots_4d_linethick p)                                            (opaque colour)-              drawOutlineAt (pmap (LValue x, LValue y))+              drawPoint psOutline (pmap (LValue x, LValue y))           )   where     scaleMax :: (PlotValue z, PlotValue t, Show t) =>@@ -188,25 +195,23 @@                           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+renderSpotLegend4D :: AreaSpots4D z t x y -> Rect -> ChartBackend ()+renderSpotLegend4D p r@(Rect p1 p2) = 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 $+    let psSpot    = filledCircles radius $                                           flip withOpacity-                                               (area_spots_4d_opacity_ p) $-                                          head $ area_spots_4d_palette_ p-    drawSpotAt centre-    let (CairoPointStyle drawOutlineAt) = hollowCircles radius-                                            (area_spots_4d_linethick_ p)+                                               (_area_spots_4d_opacity p) $+                                          head $ _area_spots_4d_palette p+    drawPoint psSpot centre+    let psOutline = hollowCircles radius+                                            (_area_spots_4d_linethick p)                                             (opaque $-                                             head (area_spots_4d_palette_ p))-    drawOutlineAt centre+                                             head (_area_spots_4d_palette p))+    drawPoint psOutline 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 )+$( makeLenses ''AreaSpots )+$( makeLenses ''AreaSpots4D )

@@ -6,7 +6,7 @@ -- -- Bar Charts ---{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.Bars(     PlotBars(..),@@ -28,17 +28,18 @@  ) where -import Data.Accessor.Template+import Control.Lens import Control.Monad import Data.List(nub,sort)-import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing 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)+import Data.Default.Class  class PlotValue a => BarsPlotValue a where     barsReference :: a@@ -79,112 +80,118 @@ 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,+   _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) ],+   _plot_bars_item_styles     :: [ (FillStyle,Maybe LineStyle) ],     -- | The title of each element of [y]. These will be shown in the legend.-   plot_bars_titles_          :: [String],+   _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,+   _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,+   _plot_bars_alignment       :: PlotBarsAlignment,     -- | The starting level for the chart (normally 0).-   plot_bars_reference_       :: y,+   _plot_bars_reference       :: y, -   plot_bars_singleton_width_ :: Double,+   _plot_bars_singleton_width :: Double,     -- | The actual points to be plotted.-   plot_bars_values_          :: [ (x,[y]) ]+   _plot_bars_values          :: [ (x,[y]) ] } +{-# DEPRECATED defaultPlotBars "Use the according Data.Default instance!" #-} 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))+defaultPlotBars = def +instance BarsPlotValue y => Default (PlotBars x y) where+  def = 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)+        _plot_render     = renderPlotBars p,+        _plot_legend     = zip (_plot_bars_titles p)                                (map renderPlotLegendBars-                                    (plot_bars_item_styles_ p)),-        plot_all_points_ = allBarPoints p+                                    (_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+renderPlotBars :: (BarsPlotValue y) => PlotBars x y -> PointMapFn x y -> ChartBackend ()+renderPlotBars p pmap = case (_plot_bars_style p) of       BarsClustered -> forM_ vals clusteredBars       BarsStacked   -> forM_ vals stackedBars   where-    clusteredBars (x,ys) = preserveCState $ do+    clusteredBars (x,ys) = do        forM_ (zip3 [0,1..] ys styles) $ \(i, y, (fstyle,_)) -> do-           setFillStyle fstyle-           fillPath (barPath (offset i) x yref0 y)-           c $ C.fill+           withFillStyle fstyle $ do+             p <- alignFillPath (barPath (offset i) x yref0 y)+             fillPath p        forM_ (zip3 [0,1..] ys styles) $ \(i, y, (_,mlstyle)) -> do            whenJust mlstyle $ \lstyle -> do-             setLineStyle lstyle-             strokePath (barPath (offset i) x yref0 y)+             withLineStyle lstyle $ do+               p <- alignStrokePath (barPath (offset i) x yref0 y)+               strokePath p -    offset = case (plot_bars_alignment_ p) of+    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+    stackedBars (x,ys) = do        let y2s = zip (yref0:stack ys) (stack ys)-       let ofs = case (plot_bars_alignment_ p) of {+       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)+           withFillStyle fstyle $ do+             p <- alignFillPath (barPath ofs x y0 y1)+             fillPath p        forM_ (zip y2s styles) $ \((y0,y1), (_,mlstyle)) -> do            whenJust mlstyle $ \lstyle -> do-               setLineStyle lstyle-               strokePath (barPath ofs x y0 y1)+              withLineStyle lstyle $ do+                p <- alignStrokePath (barPath ofs x y0 y1)+                strokePath p      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+    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+            case (_plot_bars_style p) of                 BarsClustered -> w / fromIntegral nys                 BarsStacked -> w         BarsFixWidth width -> width-    styles = plot_bars_item_styles_ p+    styles = _plot_bars_item_styles p      minXInterval = let diffs = zipWith (-) (tail mxs) mxs                    in if null diffs-                        then plot_bars_singleton_width_ p+                        then _plot_bars_singleton_width p                         else minimum diffs       where         xs  = fst (allBarPoints p)@@ -200,26 +207,20 @@ whenJust _        _ = return ()  allBarPoints :: (BarsPlotValue y) => PlotBars x y -> ([x],[y])-allBarPoints p = case (plot_bars_style_ p) of+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+    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 :: (FillStyle,Maybe LineStyle) -> Rect -> ChartBackend () renderPlotLegendBars (fstyle,mlstyle) r@(Rect p1 p2) = do-    setFillStyle fstyle+  withFillStyle fstyle $ do     fillPath (rectPath r) -------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor--- for each field.--$( deriveAccessors ''PlotBars )-+$( makeLenses ''PlotBars )

@@ -6,7 +6,7 @@ -- -- Candlestick charts for financial plotting ---{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.Candle(     PlotCandle(..),@@ -24,15 +24,18 @@     plot_candle_values, ) where -import Data.Accessor.Template-import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types+import Control.Lens+import Data.Monoid++import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing 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)+import Data.Default.Class  -- | Value defining a financial interval: opening and closing prices, with --   maxima and minima; and a style in which to render them.@@ -41,15 +44,15 @@ --   (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]+    _plot_candle_title           :: String,+    _plot_candle_line_style      :: LineStyle,+    _plot_candle_fill            :: Bool,+    _plot_candle_rise_fill_style :: FillStyle,+    _plot_candle_fall_fill_style :: FillStyle,+    _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.@@ -65,18 +68,18 @@  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+        _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+        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)+renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> ChartBackend ()+renderPlotCandle p pmap = 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'@@ -88,55 +91,45 @@     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+        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+        when f $ withFillStyle (if open >= close+                                   then _plot_candle_rise_fill_style ps+                                   else _plot_candle_fall_fill_style ps) $ do+                    fillPath $ moveTo' (x-wd) open+                            <> lineTo' (x-wd) close+                            <> lineTo' (x+wd) close+                            <> lineTo' (x+wd) open+                            <> lineTo' (x-wd) open -        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+        withLineStyle (_plot_candle_line_style ps) $ do+          strokePath $ moveTo' (x-wd) open+                    <> lineTo' (x-wd) close+                    <> lineTo' (x+wd) close+                    <> lineTo' (x+wd) open+                    <> lineTo' (x-wd) open -        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+          strokePath $ moveTo' x (min lo hi)+                    <> lineTo' x (min open close)+                    <> moveTo' x (max open close)+                    <> lineTo' x (max hi lo) -        when (ct > 0) $ do c $ C.moveTo (x-ct) mid-                           c $ C.lineTo (x+ct) mid-                           c $ C.stroke+          when (tl > 0) $ strokePath $ moveTo' (x-tl) lo+                                    <> lineTo' (x+tl) lo+                                    <> moveTo' (x-tl) hi+                                    <> lineTo' (x+tl) hi+          +          when (ct > 0) $ do strokePath $ moveTo' (x-ct) mid+                                       <> lineTo' (x+ct) mid -renderPlotLegendCandle :: PlotCandle x y -> Rect -> CRender ()-renderPlotLegendCandle p r@(Rect p1 p2) = preserveCState $ do-    drawCandle p{ plot_candle_width_ = 2}+renderPlotLegendCandle :: PlotCandle x y -> Rect -> ChartBackend ()+renderPlotLegendCandle p r@(Rect p1 p2) = 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}+    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)@@ -145,21 +138,21 @@     open  = (lo + mid) / 2     close = (mid + hi) / 2 +{-# DEPRECATED defaultPlotCandle "Use the according Data.Default instance!" #-} 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_      = []-}+defaultPlotCandle = def -------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor--- for each field.+instance Default (PlotCandle x y) where+  def = 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      = []+    } -$( deriveAccessors ''PlotCandle )+$( makeLenses ''PlotCandle )

@@ -6,7 +6,7 @@ -- -- Plot series of points with associated error bars. ---{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.ErrBars(     PlotErrBars(..),@@ -25,14 +25,17 @@     plot_errbars_values, ) where -import Data.Accessor.Template-import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types+import Control.Lens+import Data.Monoid++import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing 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)+import Data.Default.Class  -- | Value for holding a point with associated error bounds for each axis. @@ -55,29 +58,29 @@ -- | 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]+    _plot_errbars_title       :: String,+    _plot_errbars_line_style  :: LineStyle,+    _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]+        _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+        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)+renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> ChartBackend ()+renderPlotErrBars p pmap = 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')@@ -88,26 +91,24 @@     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+        let tl = _plot_errbars_tick_length ps+        let oh = _plot_errbars_overhang ps+        withLineStyle (_plot_errbars_line_style ps) $ do+          strokePath $ moveTo' (xl-oh) y+                    <> lineTo' (xh+oh) y+                    <> moveTo' x (yl-oh)+                    <> lineTo' x (yh+oh)+                    <> moveTo' xl (y-tl)+                    <> lineTo' xl (y+tl)+                    <> moveTo' (x-tl) yl+                    <> lineTo' (x+tl) yl+                    <> moveTo' xh (y-tl)+                    <> lineTo' xh (y+tl)+                    <> moveTo' (x-tl) yh+                    <> lineTo' (x+tl) yh -renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> CRender ()-renderPlotLegendErrBars p r@(Rect p1 p2) = preserveCState $ do+renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> ChartBackend ()+renderPlotLegendErrBars p r@(Rect p1 p2) = 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)@@ -116,17 +117,17 @@     drawErrBar = drawErrBar0 p     dx         = min ((p_x p2 - p_x p1)/6) ((p_y p2 - p_y p1)/2) +{-# DEPRECATED defaultPlotErrBars "Use the according Data.Default instance!" #-} 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_      = []-}+defaultPlotErrBars = def -------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor--- for each field.+instance Default (PlotErrBars x y) where+  def = PlotErrBars +    { _plot_errbars_title       = ""+    , _plot_errbars_line_style  = solidLine 1 $ opaque blue+    , _plot_errbars_tick_length = 3+    , _plot_errbars_overhang    = 0+    , _plot_errbars_values      = []+    } -$( deriveAccessors ''PlotErrBars )+$( makeLenses ''PlotErrBars )

@@ -6,7 +6,7 @@ -- -- Plots that fill the area between two lines. ---{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.FillBetween(     PlotFillBetween(..),@@ -19,66 +19,67 @@     plot_fillbetween_values, ) where -import Data.Accessor.Template-import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types+import Control.Lens+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing 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)+import Data.Default.Class  -- | 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))]+    _plot_fillbetween_title  :: String,+    _plot_fillbetween_style  :: FillStyle,+    _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+        _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 :: PlotFillBetween x y -> PointMapFn x y -> ChartBackend () renderPlotFillBetween p pmap =-    renderPlotFillBetween' p (plot_fillbetween_values_ 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])+renderPlotFillBetween' p vs pmap  = +  withFillStyle (_plot_fillbetween_style p) $ do+    ps <- alignFillPoints $ [p0] ++ p1s ++ reverse p2s ++ [p0]+    fillPointPath ps   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)+renderPlotLegendFill :: PlotFillBetween x y -> Rect -> ChartBackend ()+renderPlotLegendFill p r = +  withFillStyle (_plot_fillbetween_style p) $ do     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-+    pts = _plot_fillbetween_values p +{-# DEPRECATED defaultPlotFillBetween "Use the according Data.Default instance!" #-} defaultPlotFillBetween :: PlotFillBetween x y-defaultPlotFillBetween = PlotFillBetween {-    plot_fillbetween_title_  = "",-    plot_fillbetween_style_  = solidFillStyle (opaque $ sRGB 0.5 0.5 1.0),-    plot_fillbetween_values_ = []-}+defaultPlotFillBetween = def  -------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor--- for each field.+instance Default (PlotFillBetween x y) where+  def = PlotFillBetween +    { _plot_fillbetween_title  = ""+    , _plot_fillbetween_style  = solidFillStyle (opaque $ sRGB 0.5 0.5 1.0)+    , _plot_fillbetween_values = []+    } -$( deriveAccessors ''PlotFillBetween )+$( makeLenses ''PlotFillBetween )

@@ -7,35 +7,30 @@ -- Plots that don't show, but occupy space so as to effect axis -- scaling ---{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  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 Control.Lens+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing 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]+    _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)+        _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 )-+$( makeLenses ''PlotHidden )

@@ -6,7 +6,7 @@ -- -- Line plots ---{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.Lines(     PlotLines(..),@@ -21,89 +21,88 @@     plot_lines_limit_values, ) where -import Data.Accessor.Template-import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types+import Control.Lens+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Data.Colour (opaque) import Data.Colour.Names (black, blue)+import Data.Default.Class  -- | 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_title        :: String,+    _plot_lines_style        :: LineStyle,      -- | The lines to be plotted-    plot_lines_values_       :: [[(x,y)]],+    _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)]]+    _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 )+        _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)]+        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)+renderPlotLines :: PlotLines x y -> PointMapFn x y -> ChartBackend ()+renderPlotLines p pmap = +  withLineStyle (_plot_lines_style p) $ do+    mapM_ (drawLines (mapXY pmap)) (_plot_lines_values p)+    mapM_ (drawLines pmap) (_plot_lines_limit_values p)   where-    drawLines mapfn pts = strokePath (map mapfn pts)+    drawLines mapfn pts = alignStrokePoints (map mapfn pts) >>= strokePointPath  -renderPlotLegendLines :: PlotLines x y -> Rect -> CRender ()-renderPlotLegendLines p r@(Rect p1 p2) = preserveCState $ do-    setLineStyle (plot_lines_style_ p)+renderPlotLegendLines :: PlotLines x y -> Rect -> ChartBackend ()+renderPlotLegendLines p r@(Rect p1 p2) = +  withLineStyle (_plot_lines_style p) $ do     let y = (p_y p1 + p_y p2) / 2-    strokePath [Point (p_x p1) y, Point (p_x p2) y]+    ps <- alignStrokePoints [Point (p_x p1) y, Point (p_x p2) y]+    strokePointPath ps -defaultPlotLineStyle :: CairoLineStyle+defaultPlotLineStyle :: LineStyle defaultPlotLineStyle = (solidLine 1 $ opaque blue){-     line_cap_  = C.LineCapRound,-     line_join_ = C.LineJoinRound+     _line_cap  = LineCapRound,+     _line_join = LineJoinRound  } +{-# DEPRECATED defaultPlotLines "Use the according Data.Default instance!" #-} defaultPlotLines :: PlotLines x y-defaultPlotLines = PlotLines {-    plot_lines_title_        = "",-    plot_lines_style_        = defaultPlotLineStyle,-    plot_lines_values_       = [],-    plot_lines_limit_values_ = []-}+defaultPlotLines = def +instance Default (PlotLines x y) where+  def = 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 :: String -> LineStyle -> 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)]]+    _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 :: String -> LineStyle -> 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)]]+    _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 )----+$( makeLenses ''PlotLines )

@@ -18,8 +18,7 @@ --        $ defaultPieLayout
 -- renderable = toRenderable layout
 -- @
-
-{-# OPTIONS_GHC -XTemplateHaskell #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Graphics.Rendering.Chart.Plot.Pie(
     PieLayout(..),
@@ -28,6 +27,9 @@     defaultPieLayout,
     defaultPieChart,
     defaultPieItem,
+    
+    pieToRenderable,
+    pieChartToRenderable,
 
     pie_title,
     pie_title_style,
@@ -46,158 +48,176 @@ ) 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 Control.Lens hiding (moveTo)
 import Data.Colour
 import Data.Colour.Names (black, white)
+import Data.Monoid
+import Data.Default.Class
 import Control.Monad
 
-import Graphics.Rendering.Chart.Types
+import Graphics.Rendering.Chart.Geometry
+import Graphics.Rendering.Chart.Drawing
 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
+   _pie_title       :: String,
+   _pie_title_style :: FontStyle,
+   _pie_plot        :: PieChart,
+   _pie_background  :: FillStyle,
+   _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
+   _pie_data             :: [PieItem],
+   _pie_colors           :: [AlphaColour Double],
+   _pie_label_style      :: FontStyle,
+   _pie_label_line_style :: LineStyle, 
+   _pie_start_angle      :: Double
 
 }
 
 data PieItem = PieItem {
-   pitem_label_  :: String,
-   pitem_offset_ :: Double,
-   pitem_value_  :: Double
+   _pitem_label  :: String,
+   _pitem_offset :: Double,
+   _pitem_value  :: Double
 }
 
+{-# DEPRECATED defaultPieChart  "Use the according Data.Default instance!" #-}
 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
-}
+defaultPieChart = def
 
+instance Default PieChart where
+  def = PieChart 
+    { _pie_data             = []
+    , _pie_colors           = defaultColorSeq
+    , _pie_label_style      = def
+    , _pie_label_line_style = solidLine 1 $ opaque black
+    , _pie_start_angle      = 0
+    }
+
+{-# DEPRECATED defaultPieItem  "Use the according Data.Default instance!" #-}
 defaultPieItem :: PieItem
-defaultPieItem = PieItem "" 0 0
+defaultPieItem = def
 
+instance Default PieItem where
+  def = PieItem "" 0 0
+
+{-# DEPRECATED defaultPieLayout  "Use the according Data.Default instance!" #-}
 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
-}
+defaultPieLayout = def
 
+instance Default PieLayout where
+  def = PieLayout 
+    { _pie_background  = solidFillStyle $ opaque white
+    , _pie_title       = ""
+    , _pie_title_style = def { _font_size   = 15
+                             , _font_weight = FontWeightBold }
+    , _pie_plot        = defaultPieChart
+    , _pie_margin      = 10
+    }
+
 instance ToRenderable PieLayout where
-    toRenderable p = fillBackground (pie_background_ p) (
+  toRenderable = setPickFn nullPickFn . pieToRenderable
+
+pieChartToRenderable :: PieChart -> Renderable (PickFn a)
+pieChartToRenderable p = Renderable { minsize = minsizePie p
+                                    , render  = renderPie p
+                                    }
+
+instance ToRenderable PieChart where
+  toRenderable = setPickFn nullPickFn . pieChartToRenderable
+
+pieToRenderable :: PieLayout -> Renderable (PickFn a)
+pieToRenderable 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)
+                                             (pieChartToRenderable $ _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
-    }
+        title = label (_pie_title_style p) HTA_Centre VTA_Top (_pie_title p)
+        lm    = _pie_margin p
 
+extraSpace :: PieChart -> ChartBackend (Double, Double)
 extraSpace p = do
-    textSizes <- mapM textSize (map pitem_label_ (pie_data_ p))
+    textSizes <- mapM textDimension (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 maxo  = foldr (max._pitem_offset) 0 (_pie_data p)
     let extra = label_rgap + label_rlength + maxo
     return (extra + maxw, extra + maxh )
 
+minsizePie :: PieChart -> ChartBackend (Double, Double)
 minsizePie p = do
     (extraw,extrah) <- extraSpace p
     return (extraw * 2, extrah * 2)
 
+renderPie :: PieChart -> (Double, Double) -> ChartBackend (PickFn a)
 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)
+    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 ]
+        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
+              -> ChartBackend Double
         paint center radius a1 (color,pitem) = do
-            let ax     = 360.0 * (pitem_value_ pitem)
+            let ax     = 360.0 * (_pitem_value pitem)
             let a2     = a1 + (ax / 2)
             let a3     = a1 + ax
-            let offset = pitem_offset_ pitem
+            let offset = _pitem_offset pitem
 
             pieSlice (ray a2 offset) a1 a3 color
-            pieLabel (pitem_label_ pitem) a2 offset
+            pieLabel (_pitem_label pitem) a2 offset
 
             return a3
 
             where
-                pieLabel :: String -> Double -> Double -> CRender ()
+                pieLabel :: String -> Double -> Double -> ChartBackend ()
                 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
+                    withFontStyle (_pie_label_style p) $ do
+                      withLineStyle (_pie_label_line_style p) $ do
+                        let p1 = ray angle (radius+label_rgap+label_rlength+offset)
+                        p1a <- alignStrokePoint $ p1
+                        (tw,th) <- textDimension name
+                        let (offset',anchor) = if angle < 90 || angle > 270 
+                                              then ((0+),HTA_Left)
+                                              else ((0-),HTA_Right)
+                        p0 <- alignStrokePoint $ ray angle (radius + label_rgap+offset)
+                        strokePath $ moveTo p0
+                                  <> lineTo p1a
+                                  <> lineTo' (p_x p1a + (offset' (tw + label_rgap))) (p_y p1a)
 
-                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
+                        let p2 = p1 `pvadd` (Vector (offset' label_rgap) 0)
+                        drawTextA anchor VTA_Bottom p2 name
 
-                    setSourceColor color
-                    C.fillPreserve
-                    C.setSourceRGBA 1 1 1 0.1
+                pieSlice :: Point -> Double -> Double -> AlphaColour Double -> ChartBackend ()
+                pieSlice (Point x y) a1 a2 color = do
+                    let path = arc' x y radius (radian a1) (radian a2)
+                            <> lineTo' x y
+                            <> lineTo' x y
+                            <> close
 
-                    C.stroke
+                    withFillStyle (FillStyleSolid color) $ do
+                      fillPath path
+                    withLineStyle (def { _line_color = withOpacity white 0.1 }) $ do
+                      strokePath path
 
                 ray :: Double -> Double -> Point
                 ray angle r = Point x' y'
@@ -216,9 +236,6 @@ 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 )
+$( makeLenses ''PieLayout )
+$( makeLenses ''PieChart )
+$( makeLenses ''PieItem )

@@ -6,7 +6,7 @@ -- -- Functions to plot sets of points, marked in various styles. -{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.Points(     PlotPoints(..),@@ -20,56 +20,57 @@     plot_points_values, ) where     -import Data.Accessor.Template-import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types+import Control.Lens+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Data.Colour (opaque) import Data.Colour.Names (black, blue)+import Data.Default.Class  -- | 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)]+    _plot_points_title  :: String,+    _plot_points_style  :: PointStyle,+    _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)+        _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+        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)+renderPlotPoints :: PlotPoints x y -> PointMapFn x y -> ChartBackend ()+renderPlotPoints p pmap = do+    mapM_ (drawPoint ps . pmap') (_plot_points_values p)   where     pmap' = mapXY pmap-    (CairoPointStyle drawPoint) = (plot_points_style_ p)+    ps = (_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))+renderPlotLegendPoints :: PlotPoints x y -> Rect -> ChartBackend ()+renderPlotLegendPoints p r@(Rect p1 p2) = do+    drawPoint ps (Point (p_x p1)              ((p_y p1 + p_y p2)/2))+    drawPoint ps (Point ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2))+    drawPoint ps (Point (p_x p2)              ((p_y p1 + p_y p2)/2))    where-    (CairoPointStyle drawPoint) = (plot_points_style_ p)+    ps = (_plot_points_style p) +{-# DEPRECATED defaultPlotPoints  "Use the according Data.Default instance!" #-} defaultPlotPoints :: PlotPoints x y-defaultPlotPoints = PlotPoints {-    plot_points_title_  = "",-    plot_points_style_  = defaultPointStyle,-    plot_points_values_ = []-}+defaultPlotPoints = def -------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor--- for each field.+instance Default (PlotPoints x y) where+  def = PlotPoints +    { _plot_points_title  = ""+    , _plot_points_style  = def+    , _plot_points_values = []+    } -$( deriveAccessors ''PlotPoints )+$( makeLenses ''PlotPoints )

@@ -7,7 +7,7 @@ -- Datatypes and functions common to the implementation of the various -- plot types. ---{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Plot.Types(     Plot(..),@@ -22,11 +22,11 @@      ) where -import qualified Graphics.Rendering.Cairo as C-import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Renderable import Control.Monad-import Data.Accessor.Template+import Control.Lens import Data.Colour import Data.Colour.Names @@ -35,16 +35,16 @@      -- | Given the mapping between model space coordinates and device     --   coordinates, render this plot into a chart.-    plot_render_     :: PointMapFn x y -> CRender (),+    _plot_render     :: PointMapFn x y -> ChartBackend (),      -- | 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 ()) ],+    _plot_legend     :: [ (String, Rect -> ChartBackend ()) ],      -- | All of the model space coordinates to be plotted. These are     --   used to autoscale the axes where necessary.-    plot_all_points_ :: ([x],[y])+    _plot_all_points :: ([x],[y]) }  -- | A type class abstracting the conversion of a value to a Plot.@@ -53,16 +53,16 @@  -- | 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) }+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 )+       = Plot{ _plot_render     = \a-> renderP a >> renderQ a+             , _plot_legend     = legendP ++ legendQ+             , _plot_all_points = ( xsP++xsQ, ysP++ysQ )              }  @@ -77,7 +77,4 @@  ---------------------------------------------------------------------- -------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor--- for each field.-$( deriveAccessors ''Plot )+$( makeLenses ''Plot )

@@ -8,19 +8,14 @@ -- is a composable drawing element, along with assorted functions to -- them. --+{-# LANGUAGE TemplateHaskell #-}  module Graphics.Rendering.Chart.Renderable(     Renderable(..),     ToRenderable(..),     PickFn,--    renderableToPNGFile,-    renderableToPDFFile,-    renderableToPSFile,-    renderableToSVGFile,--    vectorEnv,-    bitmapEnv,+    +    rectangleToRenderable,      fillBackground,     addMargins,@@ -41,13 +36,15 @@     rect_cornerStyle, ) where -import qualified Graphics.Rendering.Cairo as C-import qualified Graphics.Rendering.Cairo.Matrix as Matrix import Control.Monad-import Data.Accessor+import Control.Lens import Data.List ( nub, transpose, sort )+import Data.Monoid+import Data.Default.Class -import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing+import Graphics.Rendering.Chart.Utils  -- | A function that maps a point in device coordinates to some value. --@@ -63,18 +60,18 @@ data Renderable a = Renderable {     -- | A Cairo action to calculate a minimum size.-   minsize :: CRender RectSize,+   minsize :: ChartBackend RectSize,     -- | A Cairo action for drawing it within a rectangle.    --   The rectangle is from the origin to the given point.    --    --   The resulting "pick" function  maps a point in the image to a value.-   render  ::  RectSize -> CRender (PickFn a)+   render  :: RectSize -> ChartBackend (PickFn a) }  -- | A type class abtracting the conversion of a value to a Renderable. class ToRenderable a where-   toRenderable :: a -> Renderable ()+  toRenderable :: a -> Renderable ()  emptyRenderable :: Renderable a emptyRenderable = spacer (0,0)@@ -116,75 +113,27 @@         return (w+l+r,h+t+b)      rf (w,h) = do-        preserveCState $ do-            c $ C.translate l t-            pickf <- render rd (w-l-r,h-t-b)-            return (mkpickf pickf (t,b,l,r) (w,h))+        withTranslation (Point l t) $ do+          pickf <- render rd (w-l-r,h-t-b)+          return (mkpickf pickf (t,b,l,r) (w,h))      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+fillBackground :: FillStyle -> Renderable a -> Renderable a fillBackground fs r = r{ render = rf }   where     rf rsize@(w,h) = do-        preserveCState $ do-            setClipRegion (Point 0 0) (Point w h)-            setFillStyle fs-            c $ C.paint-	render r rsize---- | 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 (PickFn a)-renderableToPNGFile chart width height path = -    C.withImageSurface C.FormatARGB32 width height $ \result -> do-    pick <- C.renderWith result $ runCRender rfn bitmapEnv-    C.surfaceWriteToPNG result path-    return pick-  where-    rfn = do-	render chart (fromIntegral width, fromIntegral height)--renderableToFile withSurface chart width height path = -    withSurface path (fromIntegral width) (fromIntegral height) $ \result -> do-    C.renderWith result $ runCRender rfn vectorEnv-    C.surfaceFinish result-  where-    rfn = do-        render chart (fromIntegral width, fromIntegral height)-        c $ C.showPage---- | Output the given renderable to a PDF file of the specifed size---   (in points), to the specified file.-renderableToPDFFile :: Renderable a -> Int -> Int -> FilePath -> IO ()-renderableToPDFFile = renderableToFile C.withPDFSurface---- | Output the given renderable to a postscript file of the specifed size---   (in points), to the specified file.-renderableToPSFile  :: Renderable a -> Int -> Int -> FilePath -> IO ()-renderableToPSFile  = renderableToFile C.withPSSurface---- | Output the given renderable to an SVG file of the specifed size---   (in points), to the specified file.-renderableToSVGFile :: Renderable a -> Int -> Int -> FilePath -> IO ()-renderableToSVGFile = renderableToFile C.withSVGSurface--bitmapEnv :: CEnv-bitmapEnv = CEnv (adjfn 0.5) (adjfn 0.0)-  where-    adjfn offset (Point x y) = Point (adj x) (adj y)-      where-        adj v = (fromIntegral.round) v +offset--vectorEnv :: CEnv-vectorEnv = CEnv id id+      withFillStyle fs $ do+        p <- alignFillPath $ rectPath (Rect (Point 0 0) (Point w h))+        fillPath p+      render r rsize  -- | Helper function for using a renderable, when we generate it --   in the CRender monad.-embedRenderable :: CRender (Renderable a) -> Renderable a+embedRenderable :: ChartBackend (Renderable a) -> Renderable a embedRenderable ca = Renderable {    minsize = do { a <- ca; minsize a },    render  = \ r -> do { a <- ca; render a r }@@ -195,30 +144,27 @@ -- Labels  -- | Construct a renderable from a text string, aligned with the axes.-label :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> String-         -> Renderable String+label :: FontStyle -> 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 String+rlabel :: FontStyle -> HTextAnchor -> VTextAnchor -> Double -> String -> Renderable String rlabel fs hta vta rot s = Renderable { minsize = mf, render = rf }   where-    mf = preserveCState $ do-       setFontStyle fs-       (w,h) <- textSize s+    mf = withFontStyle fs $ do+       ts <- textSize s+       let (w,h) = (textSizeWidth ts, textSizeHeight ts)        return (w*acr+h*asr,w*asr+h*acr)-    rf (w0,h0) = preserveCState $ do-       setFontStyle fs-       sz@(w,h) <- textSize s-       fe <- c $ C.fontExtents-       c $ C.translate 0 (-C.fontExtentsDescent fe)-       c $ C.translate (xadj sz hta 0 w0) (yadj sz vta 0 h0)-       c $ C.rotate rot'-       c $ C.moveTo (-w/2) (h/2)-       c $ C.showText s-       return (\_-> Just s)  -- PickFn String+    rf (w0,h0) = withFontStyle fs $ do+      ts <- textSize s+      let sz@(w,h) = (textSizeWidth ts, textSizeHeight ts)+      let descent = textSizeDescent ts+      withTranslation (Point 0 (-descent)) $ do+        withTranslation (Point (xadj sz hta 0 w0) (yadj sz vta 0 h0)) $ do+          withRotation rot' $ do+            drawText (Point (-w/2) (h/2)) s+            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@@ -238,89 +184,71 @@                      | RCornerRounded Double  data Rectangle = Rectangle {-  rect_minsize_     :: RectSize,-  rect_fillStyle_   :: Maybe CairoFillStyle,-  rect_lineStyle_   :: Maybe CairoLineStyle,-  rect_cornerStyle_ :: RectCornerStyle+  _rect_minsize     :: RectSize,+  _rect_fillStyle   :: Maybe FillStyle,+  _rect_lineStyle   :: Maybe LineStyle,+  _rect_cornerStyle :: RectCornerStyle } --- | Accessor for field rect_minsize_.-rect_minsize :: Accessor Rectangle RectSize-rect_minsize     = accessor (\v->rect_minsize_ v)-                            (\a v -> v{rect_minsize_=a})---- | Accessor for field rect_fillStyle_.-rect_fillStyle :: Accessor Rectangle (Maybe CairoFillStyle)-rect_fillStyle   = accessor (\v->rect_fillStyle_ v)-                            (\a v -> v{rect_fillStyle_=a})---- | Accessor for field rect_lineStyle_.-rect_lineStyle :: Accessor Rectangle (Maybe CairoLineStyle)-rect_lineStyle   = accessor (\v->rect_lineStyle_ v)-                            (\a v -> v{rect_lineStyle_=a})---- | Accessor for field rect_cornerStyle_.-rect_cornerStyle :: Accessor Rectangle RectCornerStyle-rect_cornerStyle = accessor (\v->rect_cornerStyle_ v)-                            (\a v -> v{rect_cornerStyle_=a})--+{-# DEPRECATED defaultRectangle "Use the according Data.Default instance!" #-} defaultRectangle :: Rectangle-defaultRectangle = Rectangle {-  rect_minsize_     = (0,0),-  rect_fillStyle_   = Nothing,-  rect_lineStyle_   = Nothing,-  rect_cornerStyle_ = RCornerSquare-}+defaultRectangle = def +instance Default Rectangle where+  def = Rectangle+    { _rect_minsize     = (0,0)+    , _rect_fillStyle   = Nothing+    , _rect_lineStyle   = Nothing+    , _rect_cornerStyle = RCornerSquare+    }+ instance ToRenderable Rectangle where-   toRenderable rectangle = Renderable mf rf-     where-      mf    = return (rect_minsize_ rectangle)-      rf sz = preserveCState $ do-        maybeM () (fill sz) (rect_fillStyle_ rectangle)-        maybeM () (stroke sz) (rect_lineStyle_ rectangle)-        return nullPickFn+  toRenderable = rectangleToRenderable -      fill sz fs = do-          setFillStyle fs-          strokeRectangle sz (rect_cornerStyle_ rectangle)-          c $ C.fill+rectangleToRenderable :: Rectangle -> Renderable a+rectangleToRenderable rectangle = Renderable mf rf+  where+    mf    = return (_rect_minsize rectangle)+    rf sz = do+      maybeM () (fill sz) (_rect_fillStyle rectangle)+      maybeM () (stroke sz) (_rect_lineStyle rectangle)+      return nullPickFn -      stroke sz ls = do-          setLineStyle ls-          strokeRectangle sz (rect_cornerStyle_ rectangle)-          c $ C.stroke+    fill sz fs = do+        withFillStyle fs $ do+          fillPath $ strokeRectangleP sz (_rect_cornerStyle rectangle) -      strokeRectangle (x2,y2) RCornerSquare = c $ do-          let (x1,y1) = (0,0)-          C.moveTo x1 y1-          C.lineTo x1 y2-          C.lineTo x2 y2-          C.lineTo x2 y1-          C.lineTo x1 y1-          C.lineTo x1 y2-                                  -      strokeRectangle (x2,y2) (RCornerBevel s) = c $ do-          let (x1,y1) = (0,0)-          C.moveTo x1 (y1+s)-          C.lineTo x1 (y2-s)-          C.lineTo (x1+s) y2-          C.lineTo (x2-s) y2-          C.lineTo x2 (y2-s)-          C.lineTo x2 (y1+s)-          C.lineTo (x2-s) y1-          C.lineTo (x1+s) y1-          C.lineTo x1 (y1+s)-          C.lineTo x1 (y2-s)+    stroke sz ls = do+        withLineStyle ls $ do+          strokePath $ strokeRectangleP sz (_rect_cornerStyle rectangle) -      strokeRectangle (x2,y2) (RCornerRounded s) = c $ do-          let (x1,y1) = (0,0)-          C.arcNegative (x1+s) (y2-s) s (pi2*2) pi2 -          C.arcNegative (x2-s) (y2-s) s pi2 0-          C.arcNegative (x2-s) (y1+s) s 0 (pi2*3)-          C.arcNegative (x1+s) (y1+s) s (pi2*3) (pi2*2)-          C.lineTo x1 (y2-s)+    strokeRectangleP (x2,y2) RCornerSquare =+      let (x1,y1) = (0,0) in moveTo' x1 y1+                          <> lineTo' x1 y2+                          <> lineTo' x2 y2+                          <> lineTo' x2 y1+                          <> lineTo' x1 y1+                          <> lineTo' x1 y2+                                +    strokeRectangleP (x2,y2) (RCornerBevel s) =+      let (x1,y1) = (0,0) in moveTo' x1 (y1+s)+                          <> lineTo' x1 (y2-s)+                          <> lineTo' (x1+s) y2+                          <> lineTo' (x2-s) y2+                          <> lineTo' x2 (y2-s)+                          <> lineTo' x2 (y1+s)+                          <> lineTo' (x2-s) y1+                          <> lineTo' (x1+s) y1+                          <> lineTo' x1 (y1+s)+                          <> lineTo' x1 (y2-s) -      pi2 = pi / 2+    strokeRectangleP (x2,y2) (RCornerRounded s) =+      let (x1,y1) = (0,0) in arcNeg (Point (x1+s) (y2-s)) s (pi2*2) pi2 +                          <> arcNeg (Point (x2-s) (y2-s)) s pi2 0+                          <> arcNeg (Point (x2-s) (y1+s)) s 0 (pi2*3)+                          <> arcNeg (Point (x1+s) (y1+s)) s (pi2*3) (pi2*2)+                          <> lineTo' x1 (y2-s)+    +    pi2 = pi / 2 +$( makeLenses ''Rectangle )

@@ -27,7 +27,12 @@ ----------------------------------------------------------------------------- module Graphics.Rendering.Chart.Simple( plot, PlotKind(..), xcoords,                                         plotPDF, plotPS,-                                        plotLayout, plotPNG, Layout1DDD+                                        plotLayout, plotPNG, Layout1DDD,+                                        layout1DddToRenderable+                                      , PlotPDFType(..)+                                      , PlotPSType(..)+                                      , PlotPNGType(..)+                                      , uplot                                       ) where  import Graphics.Rendering.Chart.Simple.Internal

@@ -1,11 +1,15 @@+ module Graphics.Rendering.Chart.Simple.Internal where  import Data.Maybe ( catMaybes ) import Data.Colour import Data.Colour.Names+import Data.Default.Class  import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Utils + styleColor :: Int -> AlphaColour Double styleColor ind = colorSequence !! ind     where colorSequence = cycle $ map opaque [ blue, red, green, yellow@@ -20,8 +24,8 @@ -- When defaultLayout1 has been generalized, change this signature to  -- [InternalPlot x y] -> Layout1 x y z iplot :: [InternalPlot Double Double] -> Layout1 Double Double-iplot foobar = defaultLayout1 {-        layout1_plots_ = concat $ zipWith toplot (ip foobar) [0..]+iplot foobar = (def :: Layout1 Double Double) {+        _layout1_plots = concat $ zipWith toplot (ip foobar) [0..]     }   where     ip (xs@(IPX _ _):xyss) = map (\ys -> (xs,ys)) yss ++ ip rest@@ -35,68 +39,68 @@       where         vs = zip xs ys         plots = case catMaybes $ map plotas yks of-                    [] -> [ toPlot $ defaultPlotLines-                           { plot_lines_title_  = name yks,-                             plot_lines_values_ = [vs],-                             plot_lines_style_  = solidLine 1 (styleColor ind)+                    [] -> [ toPlot $ def+                           { _plot_lines_title  = name yks,+                             _plot_lines_values = [vs],+                             _plot_lines_style  = solidLine 1 (styleColor ind)                            } ]                     xs -> xs-        plotas Solid = Just $ toPlot $ defaultPlotLines-                         { plot_lines_title_  = name yks,-                           plot_lines_values_ = [vs],-                           plot_lines_style_  = solidLine 1 (styleColor ind) }-        plotas Dashed = Just $ toPlot $ defaultPlotLines-                         { plot_lines_title_  = name yks,-                           plot_lines_values_ = [vs],-                           plot_lines_style_  = dashedLine 1 [10,10]+        plotas Solid = Just $ toPlot $ def+                         { _plot_lines_title  = name yks,+                           _plot_lines_values = [vs],+                           _plot_lines_style  = solidLine 1 (styleColor ind) }+        plotas Dashed = Just $ toPlot $ def+                         { _plot_lines_title  = name yks,+                           _plot_lines_values = [vs],+                           _plot_lines_style  = dashedLine 1 [10,10]                                                            (styleColor ind) }-        plotas Dotted = Just $ toPlot $ defaultPlotLines-                         { plot_lines_title_  = name yks,-                           plot_lines_values_ = [vs],-                           plot_lines_style_  = dashedLine 1 [1,11]+        plotas Dotted = Just $ toPlot $ def+                         { _plot_lines_title  = name yks,+                           _plot_lines_values = [vs],+                           _plot_lines_style  = dashedLine 1 [1,11]                                                            (styleColor ind) }-        plotas FilledCircle = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = filledCircles 4+        plotas FilledCircle = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = filledCircles 4                                                            (styleColor ind) }-        plotas HollowCircle = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = hollowCircles 5 1+        plotas HollowCircle = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = hollowCircles 5 1                                                            (styleColor ind) }-        plotas Triangle = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = hollowPolygon 7 1 3 False+        plotas Triangle = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = hollowPolygon 7 1 3 False                                                            (styleColor ind) }-        plotas DownTriangle = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = hollowPolygon 7 1 3 True+        plotas DownTriangle = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = hollowPolygon 7 1 3 True                                                            (styleColor ind) }-        plotas Square = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = hollowPolygon 7 1 4 False+        plotas Square = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = hollowPolygon 7 1 4 False                                                            (styleColor ind) }-        plotas Diamond = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = hollowPolygon 7 1 4 True+        plotas Diamond = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = hollowPolygon 7 1 4 True                                                            (styleColor ind) }-        plotas Plus = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = plusses 7 1 (styleColor ind) }-        plotas Ex = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = exes 7 1 (styleColor ind) }-        plotas Star = Just $ toPlot $ defaultPlotPoints-                         { plot_points_title_  = name yks,-                           plot_points_values_ = vs,-                           plot_points_style_  = stars 7 1 (styleColor ind) }+        plotas Plus = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = plusses 7 1 (styleColor ind) }+        plotas Ex = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = exes 7 1 (styleColor ind) }+        plotas Star = Just $ toPlot $ def+                         { _plot_points_title  = name yks,+                           _plot_points_values = vs,+                           _plot_points_style  = stars 7 1 (styleColor ind) }         plotas Symbols = plotas (styleSymbol ind)         plotas _ = Nothing @@ -137,8 +141,12 @@ data InternalPlot x y = IPY [y] [PlotKind] | IPX [x] [PlotKind]  newtype Layout1DDD = Layout1DDD { plotLayout :: Layout1 Double Double }++layout1DddToRenderable :: Layout1DDD -> Renderable (Layout1Pick Double Double)+layout1DddToRenderable = layout1ToRenderable . plotLayout+ instance ToRenderable Layout1DDD where- toRenderable = toRenderable . plotLayout+  toRenderable = setPickFn nullPickFn . toRenderable  uplot :: [UPlot] -> Layout1DDD uplot us = Layout1DDD $ iplot $ nameDoubles $ evalfuncs us@@ -194,10 +202,6 @@     pld        :: FilePath -> [UPlot] -> t instance (PlotArg a, PlotPDFType r) => PlotPDFType (a -> r) where     pld fn args = \ a -> pld fn (toUPlot a ++ args)-instance PlotPDFType (IO a) where-    pld fn args = do-        renderableToPDFFile (toRenderable $ uplot (reverse args)) 640 480 fn-        return undefined  -- | Save a plot as a postscript file. @@ -207,10 +211,6 @@     pls        :: FilePath -> [UPlot] -> t instance (PlotArg a, PlotPSType r) => PlotPSType (a -> r) where     pls fn args = \ a -> pls fn (toUPlot a ++ args)-instance PlotPSType (IO a) where-    pls fn args = do-        renderableToPSFile (toRenderable $ uplot (reverse args)) 640 480 fn-        return undefined  -- | Save a plot as a png file. plotPNG :: PlotPNGType a => String -> a@@ -220,12 +220,6 @@     plp        :: FilePath -> [UPlot] -> t instance (PlotArg a, PlotPNGType r) => PlotPNGType (a -> r) where     plp fn args = \ a -> plp fn (toUPlot a ++ args)-instance PlotPNGType (IO a) where-    plp fn args = do-        renderableToPNGFile (toRenderable $ uplot (reverse args)) 640 480 fn-        return undefined--  data UPlot = UString String | UDoubles [Double] | UFunction (Double -> Double)            | UKind [PlotKind] | X [Double]

@@ -36,14 +36,15 @@   , sparkSize     -- * Rendering function   , renderSparkLine-  , sparkLineToPNG-  , sparkLineToPDF+  , sparkLineToRenderable+  , sparkWidth   ) where  import Control.Monad import Data.List import Data.Ord-import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Renderable import Data.Colour import Data.Colour.Names@@ -89,12 +90,15 @@ barSpark :: SparkOptions barSpark  = smoothSpark { so_smooth=False } -instance ToRenderable SparkLine where-    toRenderable sp = Renderable+sparkLineToRenderable :: SparkLine -> Renderable ()+sparkLineToRenderable sp = Renderable             { minsize = return (0, fromIntegral (so_height (sl_options sp)))             , render  = \_rect-> renderSparkLine sp             } +instance ToRenderable SparkLine where+  toRenderable = sparkLineToRenderable+ -- | Compute the width of a SparkLine, for rendering purposes. sparkWidth :: SparkLine -> Int sparkWidth SparkLine{sl_options=opt, sl_data=ds} =@@ -109,7 +113,7 @@ sparkSize s = (sparkWidth s, so_height (sl_options s))  -- | Render a SparkLine to a drawing surface using cairo.-renderSparkLine :: SparkLine -> CRender (PickFn ())+renderSparkLine :: SparkLine -> ChartBackend (PickFn ()) renderSparkLine SparkLine{sl_options=opt, sl_data=ds} =   let w = 4 + (so_step opt) * (length ds - 1) + extrawidth       extrawidth | so_smooth opt = 0@@ -132,38 +136,30 @@       boxpt (Point x y) = Rect (Point (x-1)(y-1)) (Point (x+1)(y+1))       fi    :: (Num b, Integral a) => a -> b       fi    = fromIntegral-  in preserveCState $ do+  in do -  setFillStyle (solidFillStyle (opaque (so_bgColor opt)))-  fillPath (rectPath (Rect (Point 0 0) (Point (fi w) (fi h))))+  withFillStyle (solidFillStyle (opaque (so_bgColor opt))) $ do+    fillPath (rectPath (Rect (Point 0 0) (Point (fi w) (fi h))))   if so_smooth opt     then do-      setLineStyle (solidLine 1 (opaque grey))-      strokePath coords+      withLineStyle (solidLine 1 (opaque grey)) $ do+        p <- alignStrokePoints coords+        strokePointPath p     else do-      setFillStyle (solidFillStyle (opaque grey))-      forM_ coords $ \ (Point x y) ->+      withFillStyle (solidFillStyle (opaque grey)) $ do+        forM_ coords $ \ (Point x y) ->           fillPath (rectPath (Rect (Point (x-1) y) (Point (x+1) (fi h))))   when (so_minMarker opt) $ do-      setFillStyle (solidFillStyle (opaque (so_minColor opt)))-      fillPath (rectPath (boxpt minpt))+      withFillStyle (solidFillStyle (opaque (so_minColor opt))) $ do+        p <- alignFillPath (rectPath (boxpt minpt))+        fillPath p   when (so_maxMarker opt) $ do-      setFillStyle (solidFillStyle (opaque (so_maxColor opt)))-      fillPath (rectPath (boxpt maxpt))+      withFillStyle (solidFillStyle (opaque (so_maxColor opt))) $ do+        p <- alignFillPath (rectPath (boxpt maxpt))+        fillPath p   when (so_lastMarker opt) $ do-      setFillStyle (solidFillStyle (opaque (so_lastColor opt)))-      fillPath (rectPath (boxpt endpt))+      withFillStyle (solidFillStyle (opaque (so_lastColor opt))) $ do+        p <- alignFillPath (rectPath (boxpt endpt))+        fillPath p   return nullPickFn --- | Generate a PNG for the sparkline, using its natural size.-sparkLineToPNG :: FilePath -> SparkLine -> IO (PickFn ())-sparkLineToPNG fp sp = renderableToPNGFile (toRenderable sp)-                                           (sparkWidth sp)-                                           (so_height (sl_options sp))-                                           fp--- | Generate a PDF for the sparkline, using its natural size.-sparkLineToPDF :: FilePath -> SparkLine -> IO ()-sparkLineToPDF fp sp = renderableToPDFFile (toRenderable sp)-                                           (sparkWidth sp)-                                           (so_height (sl_options sp))-                                           fp

@@ -1,611 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# OPTIONS_GHC -XTemplateHaskell #-}---------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.Chart.Types--- Copyright   :  (c) Tim Docker 2006--- License     :  BSD-style (see chart/COPYRIGHT)------ This module contains basic types and functions used for drawing.------ Note that template haskell is used to derive accessor functions--- (see 'Data.Accessor') for each field of the following data types:------    * 'CairoLineStyle'------    * 'CairoFontStyle'------ 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.Types(-    Rect(..),-    Point(..),-    Vector(..),--    RectSize,-    Range,--    mkrect,-    pvadd,-    pvsub,-    psub,-    vscale,-    within,--    RectEdge(..),-    Limit(..),-    PointMapFn,--    preserveCState,-    setClipRegion,-    moveTo,-    lineTo,-    rectPath,-    strokePath,-    fillPath,--    isValidNumber,-    maybeM,--    defaultColorSeq,--    setSourceColor,--    CairoLineStyle(..),-    solidLine,-    dashedLine,-    setLineStyle,--    CairoFillStyle(..),-    defaultPointStyle,-    solidFillStyle,-    setFillStyle,--    CairoFontStyle(..),-    defaultFontStyle,-    setFontStyle,--    CairoPointStyle(..),-    filledPolygon,-    hollowPolygon,-    filledCircles,-    hollowCircles,-    plusses,-    exes,-    stars,--    HTextAnchor(..),-    VTextAnchor(..),-    drawText,-    drawTextR,-    drawTextsR,-    textSize,-    textDrawRect,--    CRender(..),-    CEnv(..),-    runCRender,-    c,-    alignp,-    alignc,-    -    line_width,-    line_color,-    line_dashes,-    line_cap,-    line_join,--    font_name,-    font_size,-    font_slant,-    font_weight,-    font_color,--) where--import qualified Graphics.Rendering.Cairo as C-import Control.Monad.Reader-import Data.Accessor-import Data.Accessor.Template-import Data.Colour-import Data.Colour.SRGB-import Data.Colour.Names-import Data.List (unfoldr)---- | A point in two dimensions.-data Point = Point {-    p_x :: Double,-    p_y :: Double-} deriving Show--data Vector = Vector {-    v_x :: Double,-    v_y :: Double-} deriving Show---- | Scale a vector by a constant.-vscale :: Double -> Vector -> Vector-vscale c (Vector x y) = (Vector (x*c) (y*c))---- | Add a point and a vector.-pvadd :: Point -> Vector -> Point-pvadd (Point x1 y1) (Vector x2 y2) = (Point (x1+x2) (y1+y2))---- | Subtract a vector from a point.-pvsub :: Point -> Vector -> Point-pvsub (Point x1 y1) (Vector x2 y2) = (Point (x1-x2) (y1-y2))---- | Subtract two points.-psub :: Point -> Point -> Vector-psub (Point x1 y1) (Point x2 y2) = (Vector (x1-x2) (y1-y2))--data Limit a = LMin | LValue a | LMax-   deriving Show---- | A function mapping between points.-type PointMapFn x y = (Limit x, Limit y) -> Point---- | A rectangle is defined by two points.-data Rect = Rect Point Point-   deriving Show--data RectEdge = E_Top | E_Bottom | E_Left | E_Right---- | Create a rectangle based upon the coordinates of 4 points.-mkrect :: Point -> Point -> Point -> Point -> Rect-mkrect (Point x1 _) (Point _ y2) (Point x3 _) (Point _ y4) =-    Rect (Point x1 y2) (Point x3 y4)---- | Test if a point is within a rectangle.-within :: Point -> Rect -> Bool-within (Point x y) (Rect (Point x1 y1) (Point x2 y2)) =-    x >= x1 && x <= x2 && y >= y1 && y <= y2----------------------------------------------------------------------------- | The environment present in the CRender Monad.-data CEnv = CEnv {-    -- | An adjustment applied immediately prior to points-    --   being displayed in device coordinates.-    ---    --   When device coordinates correspond to pixels, a cleaner-    --   image is created if this transform rounds to the nearest-    --   pixel. With higher-resolution output, this transform can-    --   just be the identity function.-    cenv_point_alignfn :: Point -> Point,--    -- | A adjustment applied immediately prior to coordinates-    --   being transformed.-    cenv_coord_alignfn :: Point -> Point-}---- | The reader monad containing context information to control---   the rendering process.-newtype CRender a = DR (ReaderT CEnv C.Render a)-  deriving (Functor, Monad, MonadReader CEnv)--runCRender :: CRender a -> CEnv -> C.Render a-runCRender (DR m) e = runReaderT m e--c :: C.Render a -> CRender a-c = DR . lift- --------------------------------------------------------------------------- | Abstract data type for the style of a plotted point.------   The contained Cairo action draws a point in the desired---   style, at the supplied device coordinates.-newtype CairoPointStyle = CairoPointStyle (Point -> CRender ())---- | Data type for the style of a line.-data CairoLineStyle = CairoLineStyle {-   line_width_  :: Double,-   line_color_  :: AlphaColour Double,-   line_dashes_ :: [Double],-   line_cap_    :: C.LineCap,-   line_join_   :: C.LineJoin-}---- | Abstract data type for a fill style.------   The contained Cairo action sets the required fill---   style in the Cairo rendering state.-newtype CairoFillStyle = CairoFillStyle (CRender ())---- | Data type for a font.-data CairoFontStyle = CairoFontStyle {-      font_name_   :: String,-      font_size_   :: Double,-      font_slant_  :: C.FontSlant,-      font_weight_ :: C.FontWeight,-      font_color_  :: AlphaColour Double-}--type Range    = (Double,Double)-type RectSize = (Double,Double)--defaultColorSeq :: [AlphaColour Double]-defaultColorSeq = cycle $ map opaque [blue, red, green, yellow, cyan, magenta]--------------------------------------------------------------------------- Assorted helper functions in Cairo Usage--moveTo, lineTo :: Point -> CRender ()-moveTo p  = do-    p' <- alignp p-    c $ C.moveTo (p_x p') (p_y p')--alignp :: Point -> CRender Point-alignp p = do -    alignfn <- fmap cenv_point_alignfn ask-    return (alignfn p)--alignc :: Point -> CRender Point-alignc p = do -    alignfn <- fmap cenv_coord_alignfn ask-    return (alignfn p)--lineTo p = do-    p' <- alignp p-    c $ C.lineTo (p_x p') (p_y p')--setClipRegion :: Point -> Point -> CRender ()-setClipRegion p2 p3 = do    -    c $ C.moveTo (p_x p2) (p_y p2)-    c $ C.lineTo (p_x p2) (p_y p3)-    c $ C.lineTo (p_x p3) (p_y p3)-    c $ C.lineTo (p_x p3) (p_y p2)-    c $ C.lineTo (p_x p2) (p_y p2)-    c $ C.clip---- | Make a path from a rectangle.-rectPath :: Rect -> [Point]-rectPath (Rect p1@(Point x1 y1) p3@(Point x2 y2)) = [p1,p2,p3,p4,p1]-  where    -    p2 = (Point x1 y2)-    p4 = (Point x2 y1)--stepPath :: [Point] -> CRender()-stepPath (p:ps) = c $ do-    C.newPath                    -    C.moveTo (p_x p) (p_y p)-    mapM_ (\p -> C.lineTo (p_x p) (p_y p)) ps-stepPath _  = return ()---- | Draw lines between the specified points.------ The points will be "corrected" by the cenv_point_alignfn, so that--- when drawing bitmaps, 1 pixel wide lines will be centred on the--- pixels.-strokePath :: [Point] -> CRender()-strokePath pts = do-    alignfn <- fmap cenv_point_alignfn ask-    stepPath (map alignfn pts)-    c $ C.stroke---- | Fill the region with the given corners.------ The points will be "corrected" by the cenv_coord_alignfn, so that--- when drawing bitmaps, the edges of the region will fall between--- pixels.-fillPath ::  [Point] -> CRender()-fillPath pts = do-    alignfn <- fmap cenv_coord_alignfn ask-    stepPath (map alignfn pts)-    c $ C.fill--setFontStyle :: CairoFontStyle -> CRender ()-setFontStyle f = do-    c $ C.selectFontFace (font_name_ f) (font_slant_ f) (font_weight_ f)-    c $ C.setFontSize (font_size_ f)-    c $ setSourceColor (font_color_ f)--setLineStyle :: CairoLineStyle -> CRender ()-setLineStyle ls = do-    c $ C.setLineWidth (line_width_ ls)-    c $ setSourceColor (line_color_ ls)-    c $ C.setLineCap (line_cap_ ls)-    c $ C.setLineJoin (line_join_ ls)-    c $ C.setDash (line_dashes_ ls) 0--setFillStyle :: CairoFillStyle -> CRender ()-setFillStyle (CairoFillStyle s) = s--colourChannel :: (Floating a, Ord a) => AlphaColour a -> Colour a-colourChannel c = darken (recip (alphaChannel c)) (c `over` black)--setSourceColor :: AlphaColour Double -> C.Render ()-setSourceColor c = let (RGB r g b) = toSRGB $ colourChannel c-                   in C.setSourceRGBA r g b (alphaChannel c)---- | Return the bounding rectangle for a text string rendered---   in the current context.-textSize :: String -> CRender RectSize-textSize s = c $ do-    te <- C.textExtents s-    fe <- C.fontExtents-    return (C.textExtentsWidth te, C.fontExtentsHeight fe)--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 ()-drawText hta vta p s = drawTextR hta vta 0 p s---- | Function to draw a textual label anchored by one of its corners---   or edges, with rotation. Rotation angle is given in degrees,---   rotation is performed around anchor point.-drawTextR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> CRender ()-drawTextR hta vta angle (Point x y) s = preserveCState $ draw-    where-      draw =  c $ do te <- C.textExtents s-                     fe <- C.fontExtents-                     let lx = xadj hta (C.textExtentsWidth te)-                     let ly = yadj vta te fe-                     C.translate x y-                     C.rotate theta-                     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)-      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 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---   between C.save and C.restore).-preserveCState :: CRender a -> CRender a-preserveCState a = do -  c $ C.save-  v <- a-  c $ C.restore-  return v--------------------------------------------------------------------------filledCircles ::-     Double             -- ^ Radius of circle.-  -> AlphaColour Double -- ^ Colour.-  -> CairoPointStyle-filledCircles radius cl = CairoPointStyle rf-  where-    rf p = do-        (Point x y) <- alignp p-	c $ setSourceColor cl-        c $ C.newPath-	c $ C.arc x y radius 0 (2*pi)-	c $ C.fill--hollowCircles ::-     Double -- ^ Radius of circle.-  -> Double -- ^ Thickness of line.-  -> AlphaColour Double-  -> CairoPointStyle-hollowCircles radius w cl = CairoPointStyle rf-  where-    rf p = do-        (Point x y) <- alignp p-        c $ C.setLineWidth w-	c $ setSourceColor cl-        c $ C.newPath-	c $ C.arc x y radius 0 (2*pi)-	c $ C.stroke--hollowPolygon ::-     Double -- ^ Radius of circle.-  -> Double -- ^ Thickness of line.-  -> Int    -- ^ Number of vertices.-  -> Bool   -- ^ Is right-side-up?-  -> AlphaColour Double-  -> CairoPointStyle-hollowPolygon radius w sides isrot cl = CairoPointStyle rf-  where rf p =-            do (Point x y ) <- alignp p-               c $ C.setLineWidth w-	       c $ setSourceColor cl-               c $ C.newPath-               let intToAngle n =-                         if isrot-                         then       fromIntegral n * 2*pi / fromIntegral sides-                         else (0.5 + fromIntegral n)*2*pi / fromIntegral sides-                   angles = map intToAngle [0 .. sides-1]-                   (p:ps) = map (\a -> Point (x + radius * sin a)-                                             (y + radius * cos a))-                                angles-               moveTo p-               mapM_ lineTo (ps++[p])-	       c $ C.stroke--filledPolygon ::-     Double -- ^ Radius of circle.-  -> Int    -- ^ Number of vertices.-  -> Bool   -- ^ Is right-side-up?-  -> AlphaColour Double-  -> CairoPointStyle-filledPolygon radius sides isrot cl = CairoPointStyle rf-  where rf p =-            do (Point x y ) <- alignp p-               c $ setSourceColor cl-               c $ C.newPath-               let intToAngle n =-                         if isrot-                         then       fromIntegral n * 2*pi/fromIntegral sides-                         else (0.5 + fromIntegral n)*2*pi/fromIntegral sides-                   angles = map intToAngle [0 .. sides-1]-                   (p:ps) = map (\a -> Point (x + radius * sin a)-                                             (y + radius * cos a)) angles-               moveTo p-               mapM_ lineTo (ps++[p])-	       c $ C.fill--plusses ::-     Double -- ^ Radius of circle.-  -> Double -- ^ Thickness of line.-  -> AlphaColour Double-  -> CairoPointStyle-plusses radius w cl = CairoPointStyle rf-  where rf p = do (Point x y ) <- alignp p-                  c $ C.setLineWidth w-	          c $ setSourceColor cl-                  c $ C.newPath-                  c $ C.moveTo (x+radius) y-                  c $ C.lineTo (x-radius) y-                  c $ C.moveTo x (y-radius)-                  c $ C.lineTo x (y+radius)-	          c $ C.stroke--exes ::-     Double -- ^ Radius of circle.-  -> Double -- ^ Thickness of line.-  -> AlphaColour Double-  -> CairoPointStyle-exes radius w cl = CairoPointStyle rf-  where rad = radius / sqrt 2-        rf p = do (Point x y ) <- alignp p-                  c $ C.setLineWidth w-	          c $ setSourceColor cl-                  c $ C.newPath-                  c $ C.moveTo (x+rad) (y+rad)-                  c $ C.lineTo (x-rad) (y-rad)-                  c $ C.moveTo (x+rad) (y-rad)-                  c $ C.lineTo (x-rad) (y+rad)-	          c $ C.stroke--stars ::-     Double -- ^ Radius of circle.-  -> Double -- ^ Thickness of line.-  -> AlphaColour Double-  -> CairoPointStyle-stars radius w cl = CairoPointStyle rf-  where rad = radius / sqrt 2-        rf p = do (Point x y ) <- alignp p-                  c $ C.setLineWidth w-	          c $ setSourceColor cl-                  c $ C.newPath-                  c $ C.moveTo (x+radius) y-                  c $ C.lineTo (x-radius) y-                  c $ C.moveTo x (y-radius)-                  c $ C.lineTo x (y+radius)-                  c $ C.moveTo (x+rad) (y+rad)-                  c $ C.lineTo (x-rad) (y-rad)-                  c $ C.moveTo (x+rad) (y-rad)-                  c $ C.lineTo (x-rad) (y+rad)-	          c $ C.stroke--solidLine ::-     Double -- ^ Width of line.-  -> AlphaColour Double-  -> CairoLineStyle-solidLine w cl = CairoLineStyle w cl [] C.LineCapButt C.LineJoinMiter--dashedLine ::-     Double   -- ^ Width of line.-  -> [Double] -- ^ The dash pattern in device coordinates.-  -> AlphaColour Double-  -> CairoLineStyle-dashedLine w ds cl = CairoLineStyle w cl ds C.LineCapButt C.LineJoinMiter--solidFillStyle ::-     AlphaColour Double-  -> CairoFillStyle-solidFillStyle cl = CairoFillStyle fn-   where fn = c $ setSourceColor cl--defaultPointStyle :: CairoPointStyle-defaultPointStyle = filledCircles 1 $ opaque white--defaultFontStyle :: CairoFontStyle-defaultFontStyle = CairoFontStyle {-   font_name_   = "sans",-   font_size_   = 10,-   font_slant_  = C.FontSlantNormal,-   font_weight_ = C.FontWeightNormal,-   font_color_  = opaque black-}--isValidNumber :: (RealFloat a) => a -> Bool-isValidNumber v = not (isNaN v) && not (isInfinite v)--maybeM :: (Monad m) => b -> (a -> m b) -> Maybe a -> m b-maybeM v = maybe (return v)--------------------------------------------------------------------------- Template haskell to derive an instance of Data.Accessor.Accessor--- for each field.-$( deriveAccessors ''CairoLineStyle )-$( deriveAccessors ''CairoFontStyle )-

@@ -0,0 +1,16 @@+-- | Non chart specific utility functions.+module Graphics.Rendering.Chart.Utils(+    isValidNumber,+    maybeM,+  ) where++-- | Checks if the given value is and actual numeric value and not +--   a concept like NaN or infinity.+isValidNumber :: (RealFloat a) => a -> Bool+isValidNumber v = not (isNaN v) && not (isInfinite v)++-- | Version of 'Prelude.maybe' that returns a monadic value.+maybeM :: (Monad m) => b -> (a -> m b) -> Maybe a -> m b+maybeM v = maybe (return v)++

@@ -1,219 +0,0 @@-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))-    ]--

@@ -1,392 +0,0 @@-module Prices where--import Data.Time.Calendar-import Data.Time.LocalTime--rawPrices = [-    (03,05,2005, 16.18, 42.02),-    (04,05,2005, 16.25, 42.31),-    (05,05,2005, 16.50, 42.95),-    (06,05,2005, 16.52, 43.50),-    (09,05,2005, 16.84, 44.91),-    (10,05,2005, 16.70, 44.55),-    (11,05,2005, 16.43, 43.63),-    (12,05,2005, 16.29, 43.18),-    (13,05,2005, 15.95, 42.40),-    (16,05,2005, 15.55, 41.65),-    (17,05,2005, 15.71, 42.17),-    (18,05,2005, 15.93, 42.37),-    (19,05,2005, 16.20, 42.85),-    (20,05,2005, 15.88, 42.30),-    (23,05,2005, 15.92, 42.53),-    (24,05,2005, 16.25, 42.81),-    (25,05,2005, 16.20, 42.67),-    (26,05,2005, 16.05, 42.35),-    (27,05,2005, 16.45, 43.12),-    (30,05,2005, 16.85, 43.24),-    (31,05,2005, 16.68, 42.57),-    (01,06,2005, 16.85, 43.22),-    (02,06,2005, 17.17, 43.85),-    (03,06,2005, 17.42, 44.15),-    (06,06,2005, 17.50, 44.07),-    (07,06,2005, 17.37, 43.76),-    (08,06,2005, 17.15, 43.21),-    (09,06,2005, 17.12, 43.42),-    (10,06,2005, 17.15, 43.27),-    (14,06,2005, 17.34, 43.30),-    (15,06,2005, 17.46, 43.90),-    (16,06,2005, 17.71, 44.43),-    (17,06,2005, 18.25, 45.45),-    (20,06,2005, 18.23, 45.16),-    (21,06,2005, 18.26, 45.54),-    (22,06,2005, 18.11, 45.06),-    (23,06,2005, 17.79, 44.65),-    (24,06,2005, 17.76, 44.43),-    (27,06,2005, 17.63, 44.22),-    (28,06,2005, 18.08, 44.94),-    (29,06,2005, 18.13, 44.80),-    (30,06,2005, 18.15, 44.82),-    (01,07,2005, 18.09, 45.12),-    (04,07,2005, 18.20, 45.20),-    (05,07,2005, 18.45, 45.85),-    (06,07,2005, 18.40, 45.91),-    (07,07,2005, 18.60, 46.35),-    (08,07,2005, 18.38, 45.76),-    (11,07,2005, 18.80, 46.41),-    (12,07,2005, 18.60, 45.86),-    (13,07,2005, 18.73, 46.00),-    (14,07,2005, 18.70, 46.44),-    (15,07,2005, 18.67, 46.25),-    (18,07,2005, 18.54, 45.77),-    (19,07,2005, 18.20, 45.21),-    (20,07,2005, 18.65, 46.13),-    (21,07,2005, 19.00, 46.87),-    (22,07,2005, 19.09, 47.32),-    (25,07,2005, 19.22, 47.36),-    (26,07,2005, 19.19, 47.66),-    (27,07,2005, 19.17, 47.64),-    (28,07,2005, 19.15, 47.98),-    (29,07,2005, 19.36, 49.12),-    (01,08,2005, 19.40, 49.30),-    (02,08,2005, 19.30, 49.17),-    (03,08,2005, 19.52, 49.91),-    (04,08,2005, 19.80, 50.60),-    (05,08,2005, 19.60, 50.40),-    (08,08,2005, 19.92, 50.94),-    (09,08,2005, 20.34, 52.09),-    (10,08,2005, 20.45, 51.42),-    (11,08,2005, 20.74, 52.30),-    (12,08,2005, 21.05, 53.01),-    (15,08,2005, 21.16, 53.02),-    (16,08,2005, 20.90, 52.74),-    (17,08,2005, 20.55, 51.93),-    (18,08,2005, 20.28, 51.42),-    (19,08,2005, 20.68, 52.20),-    (22,08,2005, 21.22, 53.10),-    (23,08,2005, 21.07, 53.01),-    (24,08,2005, 20.56, 52.72),-    (25,08,2005, 19.90, 50.45),-    (26,08,2005, 20.60, 51.42),-    (29,08,2005, 20.03, 50.10),-    (30,08,2005, 20.47, 50.74),-    (31,08,2005, 20.46, 50.31),-    (01,09,2005, 20.93, 51.80),-    (02,09,2005, 20.83, 51.60),-    (05,09,2005, 20.46, 51.56),-    (06,09,2005, 20.25, 50.60),-    (07,09,2005, 20.55, 51.54),-    (08,09,2005, 20.03, 50.55),-    (09,09,2005, 20.19, 50.90),-    (12,09,2005, 20.20, 51.27),-    (13,09,2005, 20.47, 51.91),-    (14,09,2005, 20.59, 51.59),-    (15,09,2005, 20.70, 52.44),-    (16,09,2005, 20.99, 53.77),-    (19,09,2005, 21.39, 55.45),-    (20,09,2005, 21.53, 55.88),-    (21,09,2005, 20.89, 54.63),-    (22,09,2005, 21.41, 55.50),-    (23,09,2005, 21.30, 55.56),-    (26,09,2005, 21.86, 57.55),-    (27,09,2005, 22.01, 58.56),-    (28,09,2005, 21.81, 58.26),-    (29,09,2005, 22.48, 60.01),-    (30,09,2005, 22.25, 59.14),-    (03,10,2005, 22.30, 58.93),-    (04,10,2005, 22.20, 58.61),-    (05,10,2005, 21.45, 57.10),-    (06,10,2005, 20.76, 56.30),-    (07,10,2005, 20.47, 56.50),-    (10,10,2005, 20.72, 57.25),-    (11,10,2005, 20.33, 57.00),-    (12,10,2005, 20.83, 57.48),-    (13,10,2005, 20.47, 56.69),-    (14,10,2005, 19.98, 55.21),-    (17,10,2005, 20.05, 55.95),-    (18,10,2005, 20.75, 57.90),-    (19,10,2005, 20.05, 56.19),-    (20,10,2005, 20.01, 56.30),-    (21,10,2005, 20.03, 55.82),-    (24,10,2005, 19.77, 54.27),-    (25,10,2005, 20.09, 54.82),-    (26,10,2005, 20.42, 55.58),-    (27,10,2005, 20.49, 55.80),-    (28,10,2005, 20.10, 54.94),-    (31,10,2005, 20.75, 56.31),-    (01,11,2005, 20.89, 57.00),-    (02,11,2005, 20.70, 57.11),-    (03,11,2005, 21.28, 58.39),-    (04,11,2005, 21.35, 58.60),-    (07,11,2005, 21.09, 58.18),-    (08,11,2005, 21.35, 59.80),-    (09,11,2005, 21.03, 59.25),-    (10,11,2005, 21.11, 59.21),-    (11,11,2005, 21.12, 59.71),-    (14,11,2005, 21.60, 61.24),-    (15,11,2005, 21.53, 60.96),-    (16,11,2005, 21.42, 60.60),-    (17,11,2005, 21.40, 60.79),-    (18,11,2005, 21.85, 62.45),-    (21,11,2005, 21.71, 62.60),-    (22,11,2005, 21.67, 61.70),-    (23,11,2005, 21.55, 60.70),-    (24,11,2005, 21.86, 61.89),-    (25,11,2005, 22.02, 62.21),-    (28,11,2005, 22.22, 62.09),-    (29,11,2005, 21.83, 61.35),-    (30,11,2005, 21.87, 61.76),-    (01,12,2005, 21.50, 60.40),-    (02,12,2005, 21.95, 61.92),-    (05,12,2005, 22.03, 63.33),-    (06,12,2005, 21.83, 62.99),-    (07,12,2005, 21.85, 63.84),-    (08,12,2005, 21.56, 63.10),-    (09,12,2005, 21.80, 63.55),-    (12,12,2005, 21.92, 63.60),-    (13,12,2005, 21.65, 63.35),-    (14,12,2005, 21.72, 63.15),-    (15,12,2005, 21.69, 63.16),-    (16,12,2005, 21.60, 62.63),-    (19,12,2005, 21.87, 63.81),-    (20,12,2005, 22.10, 65.50),-    (21,12,2005, 22.50, 67.18),-    (22,12,2005, 22.49, 67.75),-    (23,12,2005, 22.58, 68.50),-    (28,12,2005, 22.59, 68.25),-    (29,12,2005, 22.93, 69.10),-    (30,12,2005, 22.75, 69.00),-    (03,01,2006, 23.18, 69.90),-    (04,01,2006, 23.85, 71.06),-    (05,01,2006, 23.60, 69.80),-    (06,01,2006, 23.35, 68.80),-    (09,01,2006, 24.06, 70.18),-    (10,01,2006, 23.85, 69.15),-    (11,01,2006, 23.88, 69.35),-    (12,01,2006, 23.80, 70.19),-    (13,01,2006, 23.73, 70.50),-    (16,01,2006, 23.74, 71.05),-    (17,01,2006, 23.96, 71.94),-    (18,01,2006, 23.73, 70.25),-    (19,01,2006, 24.45, 72.50),-    (20,01,2006, 24.66, 74.00),-    (23,01,2006, 24.47, 73.25),-    (24,01,2006, 24.84, 74.25),-    (25,01,2006, 25.08, 73.96),-    (27,01,2006, 26.05, 76.10),-    (30,01,2006, 26.58, 78.45),-    (31,01,2006, 25.80, 75.82),-    (01,02,2006, 25.99, 75.21),-    (02,02,2006, 25.50, 74.98),-    (03,02,2006, 25.53, 74.75),-    (06,02,2006, 25.85, 75.57),-    (07,02,2006, 25.70, 75.06),-    (08,02,2006, 24.37, 72.75),-    (09,02,2006, 24.68, 72.77),-    (13,02,2006, 23.88, 70.95),-    (14,02,2006, 24.16, 72.37),-    (15,02,2006, 24.35, 71.84),-    (16,02,2006, 24.29, 71.89),-    (17,02,2006, 23.88, 71.65),-    (20,02,2006, 24.54, 74.90),-    (21,02,2006, 24.98, 75.50),-    (22,02,2006, 24.90, 73.24),-    (23,02,2006, 25.28, 74.69),-    (24,02,2006, 24.55, 72.20),-    (27,02,2006, 24.66, 73.00),-    (28,02,2006, 24.25, 71.20),-    (01,03,2006, 24.03, 70.25),-    (02,03,2006, 24.45, 70.50),-    (03,03,2006, 24.34, 70.35),-    (06,03,2006, 24.51, 70.85),-    (08,03,2006, 23.60, 67.95),-    (09,03,2006, 23.70, 68.65),-    (10,03,2006, 23.37, 67.50),-    (13,03,2006, 23.93, 70.36),-    (14,03,2006, 23.64, 69.45),-    (15,03,2006, 23.90, 69.40),-    (16,03,2006, 24.46, 70.90),-    (17,03,2006, 24.70, 71.25),-    (20,03,2006, 25.24, 72.85),-    (21,03,2006, 25.32, 73.08),-    (22,03,2006, 25.18, 72.99),-    (23,03,2006, 25.57, 74.34),-    (24,03,2006, 25.92, 75.23),-    (27,03,2006, 26.78, 77.05),-    (28,03,2006, 26.85, 77.13),-    (30,03,2006, 27.60, 77.96),-    (31,03,2006, 28.00, 78.85),-    (03,01,2007, 23.18, 69.90),-    (04,01,2007, 23.85, 71.06),-    (05,01,2007, 23.60, 69.80),-    (06,01,2007, 23.35, 68.80),-    (09,01,2007, 24.06, 70.18),-    (10,01,2007, 23.85, 69.15),-    (11,01,2007, 23.88, 69.35),-    (12,01,2007, 23.80, 70.19),-    (13,01,2007, 23.73, 70.50),-    (16,01,2007, 23.74, 71.05),-    (17,01,2007, 23.96, 71.94),-    (18,01,2007, 23.73, 70.25),-    (19,01,2007, 24.45, 72.50),-    (20,01,2007, 24.66, 74.00),-    (23,01,2007, 24.47, 73.25),-    (24,01,2007, 24.84, 74.25),-    (25,01,2007, 25.08, 73.96),-    (27,01,2007, 26.05, 76.10),-    (30,01,2007, 26.58, 78.45),-    (31,01,2007, 25.80, 75.82),-    (01,02,2007, 25.99, 75.21),-    (02,02,2007, 25.50, 74.98),-    (03,02,2007, 25.53, 74.75),-    (06,02,2007, 25.85, 75.57),-    (07,02,2007, 25.70, 75.06),-    (08,02,2007, 24.37, 72.75),-    (09,02,2007, 24.68, 72.77),-    (13,02,2007, 23.88, 70.95),-    (14,02,2007, 24.16, 72.37),-    (15,02,2007, 24.35, 71.84),-    (16,02,2007, 24.29, 71.89),-    (17,02,2007, 23.88, 71.65),-    (20,02,2007, 24.54, 74.90),-    (21,02,2007, 24.98, 75.50),-    (22,02,2007, 24.90, 73.24),-    (23,02,2007, 25.28, 74.69),-    (24,02,2007, 24.55, 72.20),-    (27,02,2007, 24.66, 73.00),-    (28,02,2007, 24.25, 71.20),-    (01,03,2007, 24.03, 70.25),-    (02,03,2007, 24.45, 70.50),-    (03,03,2007, 24.34, 70.35),-    (06,03,2007, 24.51, 70.85),-    (08,03,2007, 23.60, 67.95),-    (09,03,2007, 23.70, 68.65),-    (10,03,2007, 23.37, 67.50),-    (13,03,2007, 23.93, 70.36),-    (14,03,2007, 23.64, 69.45),-    (15,03,2007, 23.90, 69.40),-    (16,03,2007, 24.46, 70.90),-    (17,03,2007, 24.70, 71.25),-    (20,03,2007, 25.24, 72.85),-    (21,03,2007, 25.32, 73.08),-    (22,03,2007, 25.18, 72.99),-    (23,03,2007, 25.57, 74.34),-    (24,03,2007, 25.92, 75.23),-    (27,03,2007, 26.78, 77.05),-    (28,03,2007, 26.85, 77.13),-    (30,03,2007, 27.60, 77.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 ]--hourlyPrices :: [(LocalTime,Double,Double)]-hourlyPrices = [ (mkDateTime dd mm yyyy hh 00, p1, p2)-               | (dd,mm,yyyy,hh,p1,p2) <- rawHourly ]--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 ]--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)))-

@@ -1,39 +0,0 @@-module Test1 where --import Graphics.Rendering.Chart-import Data.Colour-import Data.Colour.Names-import Data.Colour.SRGB-import Data.Accessor-import System.Environment(getArgs)--chart lwidth = toRenderable (layout lwidth)--layout :: Double -> Layout1 Double Double-layout lwidth = layout1-  where-    layout1 = layout1_title ^= "Amplitude Modulation"-            $ layout1_plots ^= [Left (toPlot sinusoid1),-			       Left (toPlot sinusoid2)]-            $ layout1_plot_background ^= Just (solidFillStyle $ opaque white)-            $ defaultLayout1--    am x = (sin (x*pi/45) + 1) / 2 * (sin (x*pi/5))--    sinusoid1 = plot_lines_values ^= [[ (x,(am x)) | x <- [0,(0.5)..400]]]-              $ plot_lines_style  ^= solidLine lwidth (opaque blue)-              $ plot_lines_title ^="am"-              $ defaultPlotLines--    sinusoid2 = plot_points_style ^= filledCircles 2 (opaque red)-              $ plot_points_values ^= [ (x,(am x)) | x <- [0,7..400]]-              $ plot_points_title ^="am points"-              $ defaultPlotPoints--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"--main = getArgs >>= main1--

@@ -1,46 +0,0 @@-module Test14 where --import Graphics.Rendering.Chart-import Data.Colour-import Data.Colour.Names-import Data.Accessor-import System.Random-import System.Environment(getArgs)-import Prices(prices1)---- demonstrate AreaSpots--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_title ^= "random value"-          $ area_spots_max_radius ^= 20-          $ area_spots_values ^= values-          $ defaultAreaSpots-    -    points = map (\ (d,v,z)-> (d,v) ) values-    values = [ (d, v, z) | ((d,v,_),z) <- zip prices1 zs ]-    zs    :: [Int]-    zs     = randoms $ mkStdGen 0--    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"--main = getArgs >>= main1

@@ -1,48 +0,0 @@-module Test14a where --import Graphics.Rendering.Chart-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"--main = getArgs >>= main1

@@ -1,43 +0,0 @@-module Test15 where --import Graphics.Rendering.Chart-import Data.Colour-import Data.Colour.Names-import Data.Accessor-import System.Environment(getArgs)--chart lo = toRenderable layout- where-  layout = -        layout1_title ^= "Legend Test"-      $ layout1_title_style ^: font_size ^= 10-      $ layout1_bottom_axis ^: laxis_generate ^= autoIndexAxis alabels-      $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide)-      $ layout1_plots ^= [ Left (plotBars bars2) ]-      $ layout1_legend ^= Just lstyle-      $ defaultLayout1 :: Layout1 PlotIndex Double--  bars2 = plot_bars_titles ^= ["A","B","C","D","E","F","G","H","I","J"]-      $ plot_bars_values ^= addIndexes [[2,3,4,2,1,5,6,4,8,1,3],-                                        [7,4,5,6,2,4,4,5,7,8,9]-                                       ]-      $ plot_bars_style ^= BarsClustered-      $ plot_bars_spacing ^= BarsFixGap 30 5-      $ plot_bars_item_styles ^= map mkstyle (cycle defaultColorSeq)-      $ defaultPlotBars--  alabels = [ "X", "Y" ]--  lstyle = legend_orientation ^= lo-         $ defaultLegendStyle--  btitle = ""-  mkstyle c = (solidFillStyle c, Nothing)--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"--main = getArgs >>= main1--

@@ -1,80 +0,0 @@-module Test17 where --import Graphics.Rendering.Chart-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 "test1_small.png"-main1 ["big"]    = renderableToPNGFile (chart 0.25) 800 600 "test1_big.png"--main = getArgs >>= main1

@@ -1,62 +0,0 @@-module Test2 where--import Graphics.Rendering.Chart-import Data.Time.LocalTime-import Data.Colour-import Data.Colour.Names-import Data.Colour.SRGB-import Data.Accessor-import System.Environment(getArgs)-import Prices(prices2)--chart :: [(LocalTime,Double,Double)] -> Bool -> Double -> Renderable ()-chart prices showMinMax lwidth = toRenderable layout-  where--    lineStyle c = line_width ^= 3 * lwidth-                $ line_color ^= c-                $ defaultPlotLines ^. plot_lines_style--    limitLineStyle c = line_width ^= lwidth-                $ line_color ^= opaque c-                $ line_dashes ^= [5,10]-                $ defaultPlotLines ^. plot_lines_style--    price1 = plot_lines_style ^= lineStyle (opaque blue)-           $ plot_lines_values ^= [[ (d, v) | (d,v,_) <- prices]]-           $ plot_lines_title ^= "price 1"-           $ defaultPlotLines--    price2 = plot_lines_style ^= lineStyle (opaque green)-	   $ plot_lines_values ^= [[ (d, v) | (d,_,v) <- prices]]-           $ plot_lines_title ^= "price 2"-           $ defaultPlotLines--    (min1,max1) = (minimum [v | (_,v,_) <- prices],maximum [v | (_,v,_) <- prices])-    (min2,max2) = (minimum [v | (_,_,v) <- prices],maximum [v | (_,_,v) <- prices])-    limits | showMinMax = [ Left $ hlinePlot "min/max" (limitLineStyle blue) min1,-                            Left $ hlinePlot "" (limitLineStyle blue) max1,-                            Right $ hlinePlot "min/max" (limitLineStyle green) min2,-                            Right $ hlinePlot "" (limitLineStyle green) max2 ]-           | otherwise  = []--    bg = opaque $ sRGB 0 0 0.25-    fg = opaque white-    fg1 = opaque $ sRGB 0.0 0.0 0.15--    layout = layout1_title ^="Price History"-           $ layout1_background ^= solidFillStyle bg-           $ updateAllAxesStyles (axis_grid_style ^= solidLine 1 fg1)-           $ layout1_left_axis ^: laxis_override ^= axisGridHide-           $ layout1_right_axis ^: laxis_override ^= axisGridHide-           $ layout1_bottom_axis ^: laxis_override ^= axisGridHide- 	   $ layout1_plots ^= ([Left (toPlot price1), Right (toPlot price2)] ++ limits)-           $ layout1_grid_last ^= False-           $ setLayout1Foreground fg-           $ defaultLayout1--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"--main = getArgs >>= main1