Chart 1.2 → 1.2.2
raw patch · 27 files changed
+633/−611 lines, 27 filesdep ~lens
Dependency ranges changed: lens
Files
- Chart.cabal +8/−3
- Graphics/Rendering/Chart/Axis/Floating.hs +62/−50
- Graphics/Rendering/Chart/Axis/Indexed.hs +6/−5
- Graphics/Rendering/Chart/Axis/Int.hs +10/−10
- Graphics/Rendering/Chart/Axis/LocalTime.hs +65/−56
- Graphics/Rendering/Chart/Axis/Types.hs +37/−39
- Graphics/Rendering/Chart/Backend.hs +9/−2
- Graphics/Rendering/Chart/Backend/Impl.hs +8/−8
- Graphics/Rendering/Chart/Backend/Types.hs +16/−6
- Graphics/Rendering/Chart/Drawing.hs +36/−32
- Graphics/Rendering/Chart/Geometry.hs +40/−40
- Graphics/Rendering/Chart/Grid.hs +61/−67
- Graphics/Rendering/Chart/Layout.hs +54/−54
- Graphics/Rendering/Chart/Legend.hs +9/−11
- Graphics/Rendering/Chart/Plot/Annotation.hs +5/−9
- Graphics/Rendering/Chart/Plot/AreaSpots.hs +29/−44
- Graphics/Rendering/Chart/Plot/Bars.hs +34/−38
- Graphics/Rendering/Chart/Plot/Candle.hs +14/−15
- Graphics/Rendering/Chart/Plot/ErrBars.hs +10/−10
- Graphics/Rendering/Chart/Plot/FillBetween.hs +12/−9
- Graphics/Rendering/Chart/Plot/Hidden.hs +6/−6
- Graphics/Rendering/Chart/Plot/Lines.hs +3/−4
- Graphics/Rendering/Chart/Plot/Pie.hs +35/−32
- Graphics/Rendering/Chart/Plot/Points.hs +9/−11
- Graphics/Rendering/Chart/Plot/Types.hs +2/−6
- Graphics/Rendering/Chart/Renderable.hs +37/−32
- Graphics/Rendering/Chart/SparkLine.hs +16/−12
Chart.cabal view
@@ -1,5 +1,5 @@ Name: Chart-Version: 1.2+Version: 1.2.2 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2010@@ -7,7 +7,10 @@ Maintainer: Tim Docker <tim@dockerz.net> Homepage: https://github.com/timbod7/haskell-chart/wiki Synopsis: A library for generating 2D Charts and Plots-Description: A library for generating 2D Charts and Plots, based upon the cairo graphics library.+Description: A library for generating 2D Charts and Plots, with backends provided by + Cairo (<http://hackage.haskell.org/package/Chart-cairo>)+ and+ Diagrams (<http://hackage.haskell.org/package/Chart-diagrams>). Category: Graphics Cabal-Version: >= 1.6 Build-Type: Simple@@ -16,10 +19,12 @@ Build-depends: base >= 3 && < 5 , old-locale , time, mtl, array- , lens >= 3.9 && < 3.11+ , lens >= 3.9 && < 4.2 , colour >= 2.2.1 && < 2.4 , data-default-class < 0.1 , operational >= 0.2.2 && < 0.3++ Ghc-options: -Wall -fno-warn-orphans Exposed-modules: Graphics.Rendering.Chart,
Graphics/Rendering/Chart/Axis/Floating.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Floating--- Copyright : (c) Tim Docker 2010+-- Copyright : (c) Tim Docker 2010, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render floating value axes@@ -37,10 +37,12 @@ import Control.Lens import Graphics.Rendering.Chart.Geometry-import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Utils import Graphics.Rendering.Chart.Axis.Types +-- Note: the following code uses explicit Integer types+-- to avoid -Wall 'defaulting to Integer' messages.+ instance PlotValue Double where toValue = id fromValue= id@@ -101,14 +103,14 @@ -- | 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+scaledAxis lap rs@(minV,maxV) ps0 = makeAxis' realToFrac realToFrac (_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)+ range _ | minV == maxV = if minV==0 then (-1,1) else+ let d = abs (minV * 0.01) in (minV-d,maxV+d)+ | otherwise = rs labelvs = map fromRational $ steps (fromIntegral (_la_nLabels lap)) r tickvs = map fromRational $ steps (fromIntegral (_la_nTicks lap)) (minimum labelvs,maximum labelvs)@@ -118,25 +120,24 @@ -- | Generate a linear axis automatically, scaled appropriately for the -- input data. autoScaledAxis :: RealFloat a => LinearAxisParams a -> AxisFn a-autoScaledAxis lap ps0 = scaledAxis lap (min,max) ps0+autoScaledAxis lap ps0 = scaledAxis lap rs ps0 where- (min,max) = (minimum ps0,maximum ps0)+ rs = (minimum ps0,maximum ps0) steps :: RealFloat a => a -> (a,a) -> [Rational]-steps nSteps (min,max) = map ((s*) . fromIntegral) [min' .. max']+steps nSteps rs@(minV,maxV) = map ((s*) . fromIntegral) [min' .. max'] where- s = chooseStep nSteps (min,max)- min' = floor $ realToFrac min / s- max' = ceiling $ realToFrac max / s- n = (max' - min')-+ s = chooseStep nSteps rs+ min' :: Integer+ min' = floor $ realToFrac minV / s+ max' = ceiling $ realToFrac maxV / s chooseStep :: RealFloat a => a -> (a,a) -> Rational-chooseStep nsteps (x1,x2) = minimumBy (comparing proximity) steps+chooseStep nsteps (x1,x2) = minimumBy (comparing proximity) stepVals where delta = x2 - x1- mult = 10 ^^ (floor $ log10 $ delta / nsteps)- steps = map (mult*) [0.1,0.2,0.25,0.5,1.0,2.0,2.5,5.0,10,20,25,50]+ mult = 10 ^^ ((floor $ log10 $ delta / nsteps)::Integer)+ stepVals = map (mult*) [0.1,0.2,0.25,0.5,1.0,2.0,2.5,5.0,10,20,25,50] proximity x = abs $ delta / realToFrac x - nsteps -- | Given a target number of values, and a list of input points,@@ -146,9 +147,9 @@ autoSteps nSteps vs = map fromRational $ steps (fromIntegral nSteps) r where range [] = (0,1)- range _ | min == max = (min-0.5,min+0.5)- | otherwise = (min,max)- (min,max) = (minimum ps,maximum ps)+ range _ | minV == maxV = (minV-0.5,minV+0.5)+ | otherwise = rs+ rs@(minV,maxV) = (minimum ps,maximum ps) ps = filter isValidNumber vs r = range ps @@ -171,11 +172,11 @@ (_loga_labelf lap) (wrap rlabelvs, wrap rtickvs, wrap rgridvs) where ps = filter (\x -> isValidNumber x && 0 < x) ps0- (min,max) = (minimum ps,maximum ps)+ (minV,maxV) = (minimum ps,maximum ps) wrap = map fromRational range [] = (3,30)- range _ | min == max = (realToFrac $ min/3, realToFrac $ max*3)- | otherwise = (realToFrac $ min, realToFrac $ max)+ range _ | minV == maxV = (realToFrac $ minV/3, realToFrac $ maxV*3)+ | otherwise = (realToFrac $ minV, realToFrac $ maxV) (rlabelvs, rtickvs, rgridvs) = logTicks (range ps) @@ -194,50 +195,61 @@ logTicks :: Range -> ([Rational],[Rational],[Rational]) logTicks (low,high) = (major,minor,major) where+ pf :: RealFrac a => a -> (Integer, a)+ pf = properFraction++ -- frac :: (RealFrac a, Integral b) => a -> (b, a)+ frac :: (RealFrac a) => a -> (Integer, a)+ frac x | 0 <= b = (a,b)+ | otherwise = (a-1,b+1)+ where+ (a,b) = properFraction x+ ratio = high/low lower a l = let (i,r) = frac (log10 a) in- (maximum (1:filter (\x -> log10 (fromRational x) <= r) l))*10^^i- upper a l = let (i,r) = properFraction (log10 a) in- (minimum (10:filter (\x -> r <= log10 (fromRational x)) l))*10^^i+ maximum (1:filter (\x -> log10 (fromRational x) <= r) l)*10^^i+ upper a l = let (i,r) = pf (log10 a) in+ minimum (10:filter (\x -> r <= log10 (fromRational x)) l)*10^^i+ powers :: (Double,Double) -> [Rational] -> [Rational]- powers (x,y) l = [ a*10^^p | p <- [(floor (log10 x))..(ceiling (log10 y))]+ powers (x,y) l = [ a*10^^p | p <- [(floor (log10 x))..(ceiling (log10 y))] :: [Integer] , a <- l ] midselection r l = filter (inRange r l) (powers r l) inRange (a,b) l x = (lower a l <= x) && (x <= upper b l)- major | 17.5 < log10 ratio = map (\x -> 10^^(round x)) $- steps (min 5 (log10 ratio))- (log10 low, log10 high)- | 12 < log10 ratio = map (\x -> 10^^(round x)) $- steps ((log10 ratio)/5) (log10 low, log10 high)- | 6 < log10 ratio = map (\x -> 10^^(round x)) $- steps ((log10 ratio)/2) (log10 low, log10 high)+ + logRange = (log10 low, log10 high)+ + roundPow x = 10^^(round x :: Integer)+ + major | 17.5 < log10 ratio = map roundPow $+ steps (min 5 (log10 ratio)) logRange+ | 12 < log10 ratio = map roundPow $+ steps (log10 ratio / 5) logRange+ | 6 < log10 ratio = map roundPow $+ steps (log10 ratio / 2) logRange | 3 < log10 ratio = midselection (low,high) [1,10] | 20 < ratio = midselection (low,high) [1,5,10] | 6 < ratio = midselection (low,high) [1,2,4,6,8,10] | 3 < ratio = midselection (low,high) [1..10] | otherwise = steps 5 (low,high)+ (l',h') = (minimum major, maximum major) (dl',dh') = (fromRational l', fromRational h')- ratio' = fromRational (h'/l')- minor | 50 < log10 ratio' = map (\x -> 10^^(round x)) $- steps 50 (log10 $ dl', log10 $ dh')- | 6 < log10 ratio' = filter (\x -> l'<=x && x <=h') $- powers (dl', dh') [1,10]- | 3 < log10 ratio' = filter (\x -> l'<=x && x <=h') $- powers (dl',dh') [1,5,10]- | 6 < ratio' = filter (\x -> l'<=x && x <=h') $- powers (dl',dh') [1..10]- | 3 < ratio' = filter (\x -> l'<=x && x <=h') $- powers (dl',dh') [1,1.2..10]+ ratio' :: Double+ ratio' = fromRational (h'/l')+ filterX = filter (\x -> l'<=x && x <=h') . powers (dl',dh') + + minor | 50 < log10 ratio' = map roundPow $+ steps 50 (log10 dl', log10 dh')+ | 6 < log10 ratio' = filterX [1,10]+ | 3 < log10 ratio' = filterX [1,5,10]+ | 6 < ratio' = filterX [1..10]+ | 3 < ratio' = filterX [1,1.2..10] | otherwise = steps 50 (dl', dh') + log10 :: (Floating a) => a -> a log10 = logBase 10--frac x | 0 <= b = (a,b)- | otherwise = (a-1,b+1)- where- (a,b) = properFraction x $( makeLenses ''LinearAxisParams ) $( makeLenses ''LogAxisParams )
Graphics/Rendering/Chart/Axis/Indexed.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Unit--- Copyright : (c) Tim Docker 2010+-- Copyright : (c) Tim Docker 2010, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render indexed axes@@ -13,7 +13,8 @@ autoIndexAxis, addIndexes, ) where- ++import Control.Arrow (first) import Data.Default.Class import Graphics.Rendering.Chart.Axis.Types@@ -30,7 +31,7 @@ -- | Augment a list of values with index numbers for plotting. addIndexes :: [a] -> [(PlotIndex,a)]-addIndexes as = map (\(i,a) -> (PlotIndex i,a)) (zip [0..] as)+addIndexes as = map (first PlotIndex) (zip [0..] as) -- | Create an axis for values indexed by position. The -- list of strings are the labels to be used.@@ -40,13 +41,13 @@ _axis_viewport = vport, _axis_tropweiv = invport, _axis_ticks = [],- _axis_labels = [filter (\(i,l) -> i >= imin && i <= imax)+ _axis_labels = [filter (\(i,_) -> i >= imin && i <= imax) (zip [0..] labels)], _axis_grid = [] } where vport r i = linMap id ( fromIntegral imin - 0.5 , fromIntegral imax + 0.5) r (fromIntegral i)- invport r z = invLinMap round fromIntegral (imin, imax) r z+ invport = invLinMap round fromIntegral (imin, imax) imin = minimum vs imax = maximum vs
Graphics/Rendering/Chart/Axis/Int.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Int--- Copyright : (c) Tim Docker 2010+-- Copyright : (c) Tim Docker 2010, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render integer indexed axes@@ -14,7 +14,6 @@ import Data.List(genericLength) import Graphics.Rendering.Chart.Geometry-import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Axis.Types import Graphics.Rendering.Chart.Axis.Floating @@ -37,18 +36,18 @@ autoScaledIntAxis :: (Integral i, PlotValue i) => LinearAxisParams i -> AxisFn i-autoScaledIntAxis lap ps = scaledIntAxis lap (min,max) ps+autoScaledIntAxis lap ps = scaledIntAxis lap rs ps where- (min,max) = (minimum ps,maximum ps)+ rs = (minimum ps,maximum ps) scaledIntAxis :: (Integral i, PlotValue i) => LinearAxisParams i -> (i,i) -> AxisFn i-scaledIntAxis lap (min,max) ps =+scaledIntAxis lap (minI,maxI) ps = 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)+ range _ | minI == maxI = (fromIntegral $ minI-1, fromIntegral $ minI+1)+ | otherwise = (fromIntegral minI, fromIntegral maxI) -- labelvs :: [i] labelvs = stepsInt (fromIntegral $ _la_nLabels lap) r tickvs = stepsInt (fromIntegral $ _la_nTicks lap)@@ -62,6 +61,7 @@ where bestSize n a (a':as) = let n' = goodness a' in if n' < n then bestSize n' a' as else a+ bestSize _ _ [] = [] goodness vs = abs (genericLength vs - nSteps) @@ -70,8 +70,8 @@ sampleSteps = [1,2,5] ++ sampleSteps1 sampleSteps1 = [10,20,25,50] ++ map (*10) sampleSteps1 - steps size (min,max) = takeWhile (<b) [a,a+size..] ++ [b]+ steps size (minV,maxV) = takeWhile (<b) [a,a+size..] ++ [b] where- a = (floor (min / fromIntegral size)) * size- b = (ceiling (max / fromIntegral size)) * size+ a = (floor (minV / fromIntegral size)) * size+ b = (ceiling (maxV / fromIntegral size)) * size
Graphics/Rendering/Chart/Axis/LocalTime.hs view
@@ -1,31 +1,32 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.LocalTime--- Copyright : (c) Tim Docker 2010+-- Copyright : (c) Tim Docker 2010, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render time axes module Graphics.Rendering.Chart.Axis.LocalTime(+ TimeSeq,+ TimeLabelFn,+ TimeLabelAlignment(..),+ timeAxis, autoTimeAxis,- days, months, years-) where+ + days, months, years,+ + -- * Utilities+ doubleFromLocalTime+ + ) where import Data.Default.Class import Data.Time import Data.Fixed import System.Locale (defaultTimeLocale)-import Control.Monad-import Data.List import Control.Lens-import Data.Colour (opaque)-import Data.Colour.Names (black, lightgrey)-import Data.Ord (comparing) -import Graphics.Rendering.Chart.Geometry-import Graphics.Rendering.Chart.Drawing-import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Axis.Types instance PlotValue LocalTime where@@ -55,21 +56,21 @@ type TimeSeq = LocalTime-> ([LocalTime],[LocalTime]) coverTS :: TimeSeq -> LocalTime -> LocalTime -> [LocalTime]-coverTS tseq min max = min' ++ enumerateTS tseq min max ++ max'+coverTS tseq minT maxT = min' ++ enumerateTS tseq minT maxT ++ max' where- min' = if elemTS min tseq then [] else take 1 (fst (tseq min))- max' = if elemTS max tseq then [] else take 1 (snd (tseq max))+ min' = if elemTS minT tseq then [] else take 1 (fst (tseq minT))+ max' = if elemTS maxT tseq then [] else take 1 (snd (tseq maxT)) enumerateTS :: TimeSeq -> LocalTime -> LocalTime -> [LocalTime]-enumerateTS tseq min max =- reverse (takeWhile (>=min) ts1) ++ takeWhile (<=max) ts2+enumerateTS tseq minT maxT =+ reverse (takeWhile (>=minT) ts1) ++ takeWhile (<=maxT) ts2 where- (ts1,ts2) = tseq min+ (ts1,ts2) = tseq minT elemTS :: LocalTime -> TimeSeq -> Bool elemTS t tseq = case tseq t of- (_,(t0:_)) | t == t0 -> True- _ -> False+ (_,t0:_) | t == t0 -> True+ _ -> False -- | How to display a time type TimeLabelFn = LocalTime -> String@@ -78,15 +79,24 @@ | BetweenTicks deriving (Show) --- | Create an 'AxisFn' to for a time axis. The first 'TimeSeq' sets the--- minor ticks, and the ultimate range will be aligned to its elements.--- The second 'TimeSeq' sets the labels and grid. The third 'TimeSeq'--- sets the second line of labels. The 'TimeLabelFn' is--- used to format LocalTimes for labels. The values to be plotted--- against this axis can be created with 'doubleFromLocalTime'.-timeAxis :: TimeSeq -> TimeSeq -> TimeLabelFn -> TimeLabelAlignment -> - TimeSeq -> TimeLabelFn -> TimeLabelAlignment -> - AxisFn LocalTime+-- | Create an 'AxisFn' to for a time axis.+--+-- The values to be plotted against this axis can be created with+-- 'doubleFromLocalTime'.+timeAxis :: + TimeSeq + -- ^ Set the minor ticks, and the final range will be aligned to its+ -- elements.+ -> TimeSeq + -- ^ Set the labels and grid.+ -> TimeLabelFn + -> TimeLabelAlignment + -> TimeSeq + -- ^ Set the second line of labels.+ -> TimeLabelFn + -- ^ Format `LocalTime` for labels.+ -> TimeLabelAlignment + -> AxisFn LocalTime timeAxis tseq lseq labelf lal cseq contextf clal pts = AxisData { _axis_visibility = def, _axis_viewport = vmap(min', max'),@@ -98,24 +108,24 @@ _axis_grid = [ t | t <- ltimes, visible t] } where- (min,max) = case pts of+ (minT,maxT) = case pts of [] -> (refLocalTime,refLocalTime) ps -> (minimum ps, maximum ps) refLocalTime = LocalTime (ModifiedJulianDay 0) midnight- times = coverTS tseq min max- ltimes = coverTS lseq min max- ctimes = coverTS cseq min max+ times = coverTS tseq minT maxT+ ltimes = coverTS lseq minT maxT+ ctimes = coverTS cseq minT maxT min' = minimum times max' = maximum times visible t = min' <= t && t <= max'- labels f ts lal =- [ (align lal m1' m2', f m1)+ labels f ts lal' =+ [ (align lal' m1' m2', f m1) | (m1,m2) <- zip ts (tail ts) , let m1' = if m1<min' then min' else m1 , let m2' = if m2>max' then max' else m2 ] align BetweenTicks m1 m2 = avg m1 m2- align UnderTicks m1 m2 = m1+ align UnderTicks m1 _ = m1 avg m1 m2 = localTimeFromDouble $ m1' + (m2' - m1')/2 where@@ -146,28 +156,27 @@ secondSeq step t = (iterate rev t1, tail (iterate fwd t1)) where h0 = todHour (localTimeOfDay t) m0 = todMin (localTimeOfDay t)- s0 = todSec (localTimeOfDay t) `truncateTo` (fromIntegral 1 / 1000)+ s0 = todSec (localTimeOfDay t) `truncateTo` (1 / 1000) t0 = LocalTime (localDay t) (TimeOfDay h0 m0 s0)- t1 = if t0 < t then t0 else (rev t0)+ t1 = if t0 < t then t0 else rev t0 rev = addTod 0 0 (negate step)- fwd = addTod 0 0 (step)+ fwd = addTod 0 0 step millis1, millis10, millis100, seconds, fiveSeconds :: TimeSeq-millis1 = secondSeq (fromIntegral 1 / 1000)-millis10 = secondSeq (fromIntegral 1 / 100)-millis100 = secondSeq (fromIntegral 1 / 10)-seconds = secondSeq (fromIntegral 1)-fiveSeconds = secondSeq (fromIntegral 5)+millis1 = secondSeq (1 / 1000)+millis10 = secondSeq (1 / 100)+millis100 = secondSeq (1 / 10)+seconds = secondSeq 1+fiveSeconds = secondSeq 5 minuteSeq :: Int -> TimeSeq minuteSeq step t = (iterate rev t1, tail (iterate fwd t1)) where h0 = todHour (localTimeOfDay t) m0 = todMin (localTimeOfDay t) t0 = LocalTime (localDay t) (TimeOfDay h0 m0 0)- t1 = if t0 < t then t0 else (rev t0)- rev = addTod 0 (negate step) (fromIntegral 0)- fwd = addTod 0 step (fromIntegral 0)-+ t1 = if t0 < t then t0 else rev t0+ rev = addTod 0 (negate step) 0+ fwd = addTod 0 step 0 minutes, fiveMinutes :: TimeSeq minutes = minuteSeq 1@@ -178,15 +187,15 @@ hours t = (iterate rev t1, tail (iterate fwd t1)) where h0 = todHour (localTimeOfDay t) t0 = LocalTime (localDay t) (TimeOfDay h0 0 0)- t1 = if t0 < t then t0 else (rev t0)- rev = addTod (-1) 0 (fromIntegral 0)- fwd = addTod 1 0 (fromIntegral 0)+ t1 = if t0 < t then t0 else rev t0+ rev = addTod (-1) 0 0+ fwd = addTod 1 0 0 -- | A 'TimeSeq' for calendar days. days :: TimeSeq days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1)) where t0 = localDay t- t1 = if (toTime t0) < t then t0 else (rev t0)+ t1 = if toTime t0 < t then t0 else rev t0 rev = pred fwd = succ toTime d = LocalTime d midnight@@ -194,8 +203,8 @@ -- | A 'TimeSeq' for calendar months. months :: TimeSeq months t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))- where t0 = let (y,m,d) = toGregorian $ localDay t in fromGregorian y m 1- t1 = if toTime t0 < t then t0 else (rev t0)+ where t0 = let (y,m,_) = toGregorian $ localDay t in fromGregorian y m 1+ t1 = if toTime t0 < t then t0 else rev t0 rev = addGregorianMonthsClip (-1) fwd = addGregorianMonthsClip 1 toTime d = LocalTime d midnight@@ -203,15 +212,15 @@ -- | A 'TimeSeq' for calendar years. years :: TimeSeq years t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))- where t0 = let (y,m,d) = toGregorian $ localDay t in y- t1 = if toTime t0 < t then t0 else (rev t0)+ where t0 = toGregorian (localDay t) ^. _1+ t1 = if toTime t0 < t then t0 else rev t0 rev = pred fwd = succ toTime y = LocalTime (fromGregorian y 1 1) midnight -- | A 'TimeSeq' for no sequence at all. noTime :: TimeSeq-noTime t = ([],[])+noTime _ = ([],[]) -- | Automatically choose a suitable time axis, based upon the time range -- of data. The values to be plotted against this axis can be created
Graphics/Rendering/Chart/Axis/Types.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Types--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Type definitions for Axes@@ -57,13 +57,9 @@ ) where -import Data.Time-import Data.Fixed-import Data.Maybe-import System.Locale (defaultTimeLocale) import Control.Monad import Data.List(sort,intersperse)-import Control.Lens+import Control.Lens hiding (at, re) import Data.Colour (opaque) import Data.Colour.Names (black, lightgrey) import Data.Default.Class@@ -183,16 +179,16 @@ axisLabelsOverride o ad = ad{ _axis_labels = [o] } minsizeAxis :: AxisT x -> ChartBackend RectSize-minsizeAxis (AxisT at as rev ad) = do- let labelVis = _axis_show_labels $ _axis_visibility $ ad- tickVis = _axis_show_ticks $ _axis_visibility $ ad+minsizeAxis (AxisT at as _ ad) = do+ let labelVis = _axis_show_labels $ _axis_visibility ad+ tickVis = _axis_show_ticks $ _axis_visibility ad labels = if labelVis then labelTexts ad else [] ticks = if tickVis then _axis_ticks ad else []- labelSizes <- withFontStyle (_axis_label_style as) $ do+ labelSizes <- withFontStyle (_axis_label_style as) $ mapM (mapM textDimension) labels let ag = _axis_label_gap as- let tsize = maximum ([0] ++ [ max 0 (-l) | (v,l) <- ticks ])+ let tsize = maximum (0 : [ max 0 (-l) | (_,l) <- ticks ]) let hw = maximum0 (map (maximum0.map fst) labelSizes) let hh = ag + tsize + (sum . intersperse ag . map (maximum0.map snd) $ labelSizes)@@ -210,15 +206,16 @@ labelTexts :: AxisData a -> [[String]] labelTexts ad = map (map snd) (_axis_labels ad) +maximum0 :: (Num a, Ord a) => [a] -> a 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 -> ChartBackend (Double,Double)-axisOverhang (AxisT at as rev ad) = do+axisOverhang (AxisT at as _ ad) = do let labels = map snd . sort . concat . _axis_labels $ ad- labelSizes <- withFontStyle (_axis_label_style as) $ do+ labelSizes <- withFontStyle (_axis_label_style as) $ mapM textDimension labels case labelSizes of [] -> return (0,0)@@ -233,17 +230,17 @@ E_Right -> ohangh renderAxis :: AxisT x -> RectSize -> ChartBackend (PickFn x)-renderAxis at@(AxisT et as rev ad) sz = do+renderAxis at@(AxisT et as _ ad) sz = do let ls = _axis_line_style as vis = _axis_visibility ad- when (_axis_show_line vis) $ do + when (_axis_show_line vis) $ withLineStyle (ls {_line_cap = LineCapSquare}) $ do p <- alignStrokePoints [Point sx sy,Point ex ey] strokePointPath p- when (_axis_show_ticks vis) $ do- withLineStyle (ls {_line_cap = LineCapButt}) $ do+ when (_axis_show_ticks vis) $ + withLineStyle (ls {_line_cap = LineCapButt}) $ mapM_ drawTick (_axis_ticks ad)- when (_axis_show_labels vis) $ do+ when (_axis_show_labels vis) $ withFontStyle (_axis_label_style as) $ do labelSizes <- mapM (mapM textDimension) (labelTexts ad) let sizes = map ((+ag).maximum0.map coord) labelSizes@@ -253,24 +250,24 @@ where (sx,sy,ex,ey,tp,axisPoint,invAxisPoint) = axisMapping at sz - drawTick (value,length) =+ drawTick (value,len) = let t1 = axisPoint value- t2 = t1 `pvadd` (vscale length tp)+ t2 = t1 `pvadd` vscale len tp in alignStrokePoints [t1,t2] >>= strokePointPath (hta,vta,coord,awayFromAxis) = case et of- E_Top -> (HTA_Centre, VTA_Bottom, snd, \v -> (Vector 0 (-v)))- E_Bottom -> (HTA_Centre, VTA_Top, snd, \v -> (Vector 0 v))- E_Left -> (HTA_Right, VTA_Centre, fst, \v -> (Vector (-v) 0))- E_Right -> (HTA_Left, VTA_Centre, fst, \v -> (Vector v 0))+ E_Top -> (HTA_Centre, VTA_Bottom, snd, \v -> Vector 0 (-v))+ E_Bottom -> (HTA_Centre, VTA_Top, snd, \v -> Vector 0 v)+ E_Left -> (HTA_Right, VTA_Centre, fst, \v -> Vector (-v) 0)+ E_Right -> (HTA_Left, VTA_Centre, fst, \v -> Vector v 0) avoidOverlaps labels = do rects <- mapM labelDrawRect labels return $ map snd . head . filter (noOverlaps . map fst)- $ map (\n -> eachNth n rects) [0 .. length rects]+ $ map (`eachNth` rects) [0 .. length rects] labelDrawRect (value,s) = do- let pt = axisPoint value `pvadd` (awayFromAxis ag)+ let pt = axisPoint value `pvadd` awayFromAxis ag r <- textDrawRect hta vta pt s return (hBufferRect r,(value,s)) @@ -279,7 +276,7 @@ mapM_ drawLabel labels' where drawLabel (value,s) = do- drawTextA hta vta (axisPoint value `pvadd` (awayFromAxis offset)) s+ drawTextA hta vta (axisPoint value `pvadd` awayFromAxis offset) s textDimension s ag = _axis_label_gap as@@ -288,7 +285,7 @@ hBufferRect :: Rect -> Rect hBufferRect (Rect p (Point x y)) = Rect p $ Point x' y where x' = x + w/2- w = x - (p_x p)+ w = x - p_x p noOverlaps :: [Rect] -> Bool noOverlaps [] = True@@ -304,6 +301,7 @@ p4 = Point x2 y1 ps = [p1,p2,p3,p4] +eachNth :: Int -> [a] -> [a] eachNth n = skipN where n' = n - 1@@ -317,15 +315,15 @@ axisMapping :: AxisT z -> RectSize -> (Double,Double,Double,Double,Vector,z->Point,Point->z)-axisMapping (AxisT et as rev ad) (x2,y2) = case et of- E_Top -> (x1,y2,x2,y2, (Vector 0 1), mapx y2, imapx)- E_Bottom -> (x1,y1,x2,y1, (Vector 0 (-1)), mapx y1, imapx)- E_Left -> (x2,y2,x2,y1, (Vector (1) 0), mapy x2, imapy) - E_Right -> (x1,y2,x1,y1, (Vector (-1) 0), mapy x1, imapy)+axisMapping (AxisT et _ rev ad) (x2,y2) = case et of+ E_Top -> (x1,y2,x2,y2, Vector 0 1, mapx y2, imapx)+ E_Bottom -> (x1,y1,x2,y1, Vector 0 (-1), mapx y1, imapx)+ E_Left -> (x2,y2,x2,y1, Vector 1 0, mapy x2, imapy) + E_Right -> (x1,y2,x1,y1, Vector (-1) 0, mapy x1, imapy) where (x1,y1) = (0,0)- xr = reverse (x1,x2)- yr = reverse (y2,y1)+ xr = reverseR (x1,x2)+ yr = reverseR (y2,y1) mapx y x = Point (_axis_viewport ad xr x) y mapy x y = Point x (_axis_viewport ad yr y)@@ -333,15 +331,15 @@ 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+ reverseR r@(r0,r1) = if rev then (r1,r0) else r -- renderAxisGrid :: RectSize -> AxisT z -> ChartBackend ()-renderAxisGrid sz@(w,h) at@(AxisT re as rev ad) = do- withLineStyle (_axis_grid_style as) $ do+renderAxisGrid sz@(w,h) at@(AxisT re as _ ad) = + withLineStyle (_axis_grid_style as) $ mapM_ (drawGridLine re) (_axis_grid ad) where- (sx,sy,ex,ey,tp,axisPoint,invAxisPoint) = axisMapping at sz+ (_,_,_,_,_,axisPoint,_) = axisMapping at sz drawGridLine E_Top = vline drawGridLine E_Bottom = vline
Graphics/Rendering/Chart/Backend.hs view
@@ -1,9 +1,16 @@--- | This module provides the API for drawing operations abstracted+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Chart.Axis.Unit+-- Copyright : (c) Tim Docker 2014+-- License : BSD-style (see chart/COPYRIGHT)+--+-- This module provides the API for drawing operations abstracted -- to arbitrary 'ChartBackend's.+ module Graphics.Rendering.Chart.Backend ( -- * The backend Monad- ChartBackend(..)+ ChartBackend , CRender -- * Backend Operations
Graphics/Rendering/Chart/Backend/Impl.hs view
@@ -1,17 +1,17 @@ {-# LANGUAGE GADTs #-} --- | This module provides the implementation details common to all 'ChartBackend's.+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Chart.Backend.Impl+-- Copyright : (c) Tim Docker 2014+-- License : BSD-style (see chart/COPYRIGHT)+--+-- 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
Graphics/Rendering/Chart/Backend/Types.hs view
@@ -1,5 +1,12 @@ {-# LANGUAGE TemplateHaskell #-} +-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Chart.Backend.Types+-- Copyright : (c) Tim Docker 2014+-- License : BSD-style (see chart/COPYRIGHT)+--+ module Graphics.Rendering.Chart.Backend.Types where import Data.Default.Class@@ -131,8 +138,8 @@ -- | Abstract data type for a fill style. ----- The contained Cairo action sets the required fill--- style in the Cairo rendering state.+-- The contained action sets the required fill+-- style in the rendering state. newtype FillStyle = FillStyleSolid { _fill_colour :: AlphaColour Double } deriving (Show, Eq)@@ -159,22 +166,25 @@ -- -- This is usually used to align prior to stroking. - -- | A adjustment applied immediately prior to coordinates+ -- | The 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.+-- | Alignment to render 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+ -- avoid messages about Integer default+ rnd :: Double -> Integer+ rnd = round+ adj v = (fromIntegral.rnd) v +offset --- | Alignment to render good on vector based graphics.+-- | Alignment to render on vector based graphics. vectorAlignmentFns :: AlignmentFns vectorAlignmentFns = AlignmentFns id id
Graphics/Rendering/Chart/Drawing.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Drawing--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- This module contains basic types and functions used for drawing.@@ -13,7 +13,7 @@ -- -- 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+-- dropped. Hence for data field @f_::F@ in type @D@, they have type -- -- @ -- f :: Control.Lens.Lens' D F@@ -85,17 +85,21 @@ ) where import Data.Default.Class-import Control.Lens hiding (moveTo)+-- lens < 4 includes Control.Lens.Zipper.moveTo which clashes+-- with Graphics.Rendering.Chart.Geometry.moveTo (so you get+-- -Wall notices). This would suggest a 'hiding (moveTo)' in+-- the import, but it's been removed in lens-4.0 and I don't+-- feel it's worth the use of conditional compilation. This does+-- lead to the qualified Geometry import below.+import Control.Lens 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+import Graphics.Rendering.Chart.Geometry hiding (moveTo)+import qualified Graphics.Rendering.Chart.Geometry as G -- ----------------------------------------------------------------------- -- Transformation helpers@@ -124,8 +128,8 @@ -- | 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+withPointStyle (PointStyle cl bcl bw _ _) m = + withLineStyle (def { _line_color = bcl, _line_width = bw }) $ withFillStyle (solidFillStyle cl) m withDefaultStyle :: ChartBackend a -> ChartBackend a@@ -137,11 +141,11 @@ -- | 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)+alignPath f = foldPath (G.moveTo . f)+ (lineTo . f)+ (arc . f)+ (arcNeg . f)+ close -- | Align the path using the environment's alignment function for points. -- This is generally useful when stroking. @@ -192,7 +196,7 @@ -- | Create a path by connecting all points with a line. -- The path is not closed. stepPath :: [Point] -> Path-stepPath (p:ps) = moveTo p+stepPath (p:ps) = G.moveTo p <> mconcat (map lineTo ps) stepPath [] = mempty @@ -211,7 +215,7 @@ -- | 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+drawTextA hta vta = drawTextR hta vta 0 -- | Draw a textual label anchored by one of its corners -- or edges, with rotation. Rotation angle is given in degrees,@@ -234,13 +238,13 @@ 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+ let -- widths = map textSizeWidth tss+ -- maxw = maximum widths maxh = maximum (map textSizeYBearing tss) gap = maxh / 2 -- half-line spacing totalHeight = fromIntegral num*maxh +@@ -253,11 +257,11 @@ ss = lines s num = length ss - drawT x y s = drawText (Point x y) s+ drawT x y = drawText (Point x y) theta = angle*pi/180.0 - yinit VTA_Top ts height = textSizeAscent ts- yinit VTA_BaseLine ts height = 0+ yinit VTA_Top ts _ = textSizeAscent ts+ yinit VTA_BaseLine _ _ = 0 yinit VTA_Centre ts height = height / 2 + textSizeAscent ts yinit VTA_Bottom ts height = height + textSizeAscent ts @@ -268,15 +272,15 @@ -- | 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)+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_Centre ts = - textSizeYBearing ts / 2 adjustTextY VTA_BaseLine _ = 0-adjustTextY VTA_Bottom ts = -(textSizeDescent ts)+adjustTextY VTA_Bottom ts = - textSizeDescent ts -- | Return the bounding rectangle for a text string positioned -- where it would be drawn by 'drawText'.@@ -343,7 +347,7 @@ 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+drawPoint ps@(PointStyle _ _ _ r shape) p = withPointStyle ps $ do p'@(Point x y) <- alignStrokePoint p case shape of PointShapeCircle -> do@@ -356,12 +360,12 @@ 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+ (p1:p1s) = map (\a -> Point (x + r * sin a)+ (y + r * cos a)) angles+ let path = G.moveTo p1 <> mconcat (map lineTo p1s) <> lineTo p1 fillPath path strokePath path- PointShapePlus -> do+ PointShapePlus -> strokePath $ moveTo' (x+r) y <> lineTo' (x-r) y <> moveTo' x (y-r)@@ -465,6 +469,6 @@ -- | Fill style that fill everything this the given colour. solidFillStyle :: AlphaColour Double -> FillStyle-solidFillStyle cl = FillStyleSolid cl+solidFillStyle = FillStyleSolid $( makeLenses ''PointStyle )
Graphics/Rendering/Chart/Geometry.hs view
@@ -1,3 +1,9 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Chart.Geometry+-- Copyright : (c) Tim Docker 2006, 2014+-- License : BSD-style (see chart/COPYRIGHT)+-- module Graphics.Rendering.Chart.Geometry ( -- * Points and Vectors Rect(..)@@ -63,19 +69,19 @@ -- | Scale a vector by a constant. vscale :: Double -> Vector -> Vector-vscale c (Vector x y) = (Vector (x*c) (y*c))+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))+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))+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))+psub (Point x1 y1) (Point x2 y2) = Vector (x1-x2) (y1-y2) data Limit a = LMin | LValue a | LMax deriving Show@@ -132,8 +138,8 @@ -- | 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)+ let p2 = Point x1 y2+ p4 = Point x2 y1 in moveTo p1 <> lineTo p2 <> lineTo p3 <> lineTo p4 <> close -- -----------------------------------------------------------------------@@ -237,15 +243,15 @@ -> m -- ^ Close -> Path -- ^ Path to fold -> m-foldPath moveTo lineTo arc arcNeg close path = - let restF = foldPath moveTo lineTo arc arcNeg close+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+ 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+ Close -> close_ -- | Enriches the path with explicit instructions to draw lines, -- that otherwise would be implicit. See 'Path' for details@@ -303,13 +309,16 @@ -- | 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')+ -- use underscore to avoid ghc complaints about shadowing the Matrix+ -- field names+ (*) (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 (-)@@ -322,13 +331,15 @@ -- | 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)+pointwise :: (Double -> Double) -> Matrix -> Matrix +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')+pointwise2 :: (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix+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@@ -336,16 +347,16 @@ -- | 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))+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)+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)+rotate r m = m * Matrix c s (-s) c 0 0 where s = sin r c = cos r @@ -360,17 +371,6 @@ -- | 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-----------+invert m@(Matrix xx_ yx_ xy_ yy_ _ _) = scalarMultiply (recip det) $ adjoint m+ where det = xx_*yy_ - yx_*xy_
Graphics/Rendering/Chart/Grid.hs view
@@ -1,14 +1,14 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Grid--- Copyright : (c) Tim Docker 2010+-- Copyright : (c) Tim Docker 2010, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- A container type for values that can be composed by horizonal -- and vertical layout. module Graphics.Rendering.Chart.Grid (- Grid, Span,+ Grid, Span, SpaceWeight, tval, tspan, empty, nullt, (.|.), (./.),@@ -26,18 +26,12 @@ fullOverlayOver ) where -import Data.List import Data.Array import Control.Monad-import Control.Monad.Trans-import Numeric import Graphics.Rendering.Chart.Renderable-import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Geometry hiding (x0, y0) import Graphics.Rendering.Chart.Drawing -import Data.Colour-import Data.Colour.Names- type Span = (Int,Int) type Size = (Int,Int) @@ -67,17 +61,17 @@ width Null = 0 width Empty = 1 width (Value _) = 1-width (Beside _ _ (w,h)) = w-width (Above _ _ (w,h)) = w-width (Overlay _ _ (w,h)) = w+width (Beside _ _ (w,_)) = w+width (Above _ _ (w,_)) = w+width (Overlay _ _ (w,_)) = w height :: Grid a -> Int height Null = 0 height Empty = 1 height (Value _) = 1-height (Beside _ _ (w,h)) = h-height (Above _ _ (w,h)) = h-height (Overlay _ _ (w,h)) = h+height (Beside _ _ (_,h)) = h+height (Above _ _ (_,h)) = h+height (Overlay _ _ (_,h)) = h -- | A 1x1 grid from a given value, with no extra space. tval :: a -> Grid a@@ -85,7 +79,7 @@ -- | A WxH (measured in cells) grid from a given value, with space weight (1,1). tspan :: a -> Span -> Grid a-tspan a span = Value (a,span,(1,1))+tspan a spn = Value (a,spn,(1,1)) -- | A 1x1 empty grid. empty :: Grid a@@ -103,30 +97,30 @@ -- | A value occupying 1 row with the same horizontal span as the grid. wideAbove :: a -> Grid a -> Grid a-wideAbove a g = (weights (0,0) $ tspan a (width g,1)) `above` g+wideAbove a g = weights (0,0) (tspan a (width g,1)) `above` g -- | A value placed below the grid, occupying 1 row with the same -- horizontal span as the grid. aboveWide :: Grid a -> a -> Grid a-aboveWide g a = g `above` (weights (0,0) $ tspan a (width g,1))+aboveWide g a = g `above` weights (0,0) (tspan a (width g,1)) -- | A value placed to the left of the grid, occupying 1 column with -- the same vertical span as the grid. tallBeside :: a -> Grid a -> Grid a-tallBeside a g = (weights (0,0) $ tspan a (1,height g)) `beside` g+tallBeside a g = weights (0,0) (tspan a (1,height g)) `beside` g -- | A value placed to the right of the grid, occupying 1 column with -- the same vertical span as the grid. besideTall :: Grid a -> a -> Grid a-besideTall g a = g `beside` (weights (0,0) $ tspan a (1,height g))+besideTall g a = g `beside` weights (0,0) (tspan a (1,height g)) -- | A value placed under a grid, with the same span as the grid. fullOverlayUnder :: a -> Grid a -> Grid a-fullOverlayUnder a g = g `overlay` (tspan a (width g,height g))+fullOverlayUnder a g = g `overlay` tspan a (width g,height g) -- | A value placed over a grid, with the same span as the grid. fullOverlayOver :: a -> Grid a -> Grid a-fullOverlayOver a g = (tspan a (width g,height g)) `overlay` g+fullOverlayOver a g = tspan a (width g,height g) `overlay` g beside Null t = t beside t Null = t@@ -154,8 +148,8 @@ -- | Sets the space weight of *every* cell of the grid to given value. weights :: SpaceWeight -> Grid a -> Grid a-weights sw Null = Null-weights sw Empty = Empty+weights _ Null = Null+weights _ Empty = Empty weights sw (Value (v,sp,_)) = Value (v,sp,sw) weights sw (Above t1 t2 sz) = Above (weights sw t1) (weights sw t2) sz weights sw (Beside t1 t2 sz) = Beside (weights sw t1) (weights sw t2) sz@@ -165,27 +159,27 @@ -- than ./. and .//. instance Functor Grid where- fmap f (Value (a,span,ew)) = Value (f a,span,ew)+ fmap f (Value (a,spn,ew)) = Value (f a,spn,ew) fmap f (Above t1 t2 s) = Above (fmap f t1) (fmap f t2) s fmap f (Beside t1 t2 s) = Beside (fmap f t1) (fmap f t2) s fmap f (Overlay t1 t2 s) = Overlay (fmap f t1) (fmap f t2) s- fmap f Empty = Empty- fmap f Null = Null+ fmap _ Empty = Empty+ fmap _ Null = Null mapGridM :: Monad m => (a -> m b) -> Grid a -> m (Grid b)-mapGridM f (Value (a,span,ew)) = do b <- f a- return (Value (b,span,ew))-mapGridM f (Above t1 t2 s) = do t1' <- mapGridM f t1- t2' <- mapGridM f t2- return (Above t1' t2' s)-mapGridM f (Beside t1 t2 s) = do t1' <- mapGridM f t1- t2' <- mapGridM f t2- return (Beside t1' t2' s)-mapGridM f (Overlay t1 t2 s) = do t1' <- mapGridM f t1- t2' <- mapGridM f t2- return (Overlay t1' t2' s)-mapGridM _ Empty = return Empty-mapGridM _ Null = return Null+mapGridM f (Value (a,spn,ew)) = do b <- f a+ return (Value (b,spn,ew))+mapGridM f (Above t1 t2 s) = do t1' <- mapGridM f t1+ t2' <- mapGridM f t2+ return (Above t1' t2' s)+mapGridM f (Beside t1 t2 s) = do t1' <- mapGridM f t1+ t2' <- mapGridM f t2+ return (Beside t1' t2' s)+mapGridM f (Overlay t1 t2 s) = do t1' <- mapGridM f t1+ t2' <- mapGridM f t2+ return (Overlay t1' t2' s)+mapGridM _ Empty = return Empty+mapGridM _ Null = return Null ---------------------------------------------------------------------- type FlatGrid a = Array (Int,Int) [(a,Span,SpaceWeight)]@@ -197,21 +191,21 @@ type FlatEl a = ((Int,Int),Cell a) flatten2 :: (Int,Int) -> Grid a -> [FlatEl a] -> [FlatEl a]-flatten2 i Empty els = els-flatten2 i Null els = els+flatten2 _ Empty els = els+flatten2 _ Null els = els flatten2 i (Value cell) els = (i,cell):els -flatten2 i@(x,y) (Above t1 t2 size) els = (f1.f2) els+flatten2 i@(x,y) (Above t1 t2 _) els = (f1.f2) els where f1 = flatten2 i t1 f2 = flatten2 (x,y + height t1) t2 -flatten2 i@(x,y) (Beside t1 t2 size) els = (f1.f2) els+flatten2 i@(x,y) (Beside t1 t2 _) els = (f1.f2) els where f1 = flatten2 i t1 f2 = flatten2 (x + width t1, y) t2 -flatten2 i@(x,y) (Overlay t1 t2 size) els = (f1.f2) els+flatten2 i (Overlay t1 t2 _) els = (f1.f2) els where f1 = flatten2 i t1 f2 = flatten2 i t2@@ -219,7 +213,7 @@ foldT :: ((Int,Int) -> Cell a -> r -> r) -> r -> FlatGrid a -> r foldT f iv ft = foldr f' iv (assocs ft) where- f' (i,vs) r = foldr (\cell -> f i cell) r vs+ f' (i,vs) r = foldr (f i) r vs ---------------------------------------------------------------------- type DArray = Array Int Double@@ -238,53 +232,53 @@ (foldT (ef ywf snd) [] szs') return (widths,heights,xweights,yweights) where- wf (x,y) (w,h) (ww,wh) = (x,w)- hf (x,y) (w,h) (ww,wh) = (y,h)- xwf (x,y) (w,h) (xw,yw) = (x,xw)- ywf (x,y) (w,h) (xw,yw) = (y,yw)+ wf (x,_) (w,_) _ = (x,w)+ hf (_,y) (_,h) _ = (y,h)+ xwf (x,_) _ (xw,_) = (x,xw)+ ywf (_,y) _ (_,yw) = (y,yw) - ef f ds loc (size,span,ew) r | ds span == 1 = (f loc size ew:r)- | otherwise = r+ ef f ds loc (size,spn,ew) r | ds spn == 1 = f loc size ew:r+ | otherwise = r instance (ToRenderable a) => ToRenderable (Grid a) where toRenderable = gridToRenderable . fmap toRenderable gridToRenderable :: Grid (Renderable a) -> Renderable a-gridToRenderable t = Renderable minsizef renderf+gridToRenderable gt = Renderable minsizef renderf where minsizef :: ChartBackend RectSize minsizef = do- (widths, heights, xweights, yweights) <- getSizes t+ (widths, heights, _, _) <- getSizes gt return (sum (elems widths), sum (elems heights)) renderf (w,h) = do- (widths, heights, xweights, yweights) <- getSizes t+ (widths, heights, xweights, yweights) <- getSizes gt let widths' = addExtraSpace w widths xweights let heights' = addExtraSpace h heights yweights let borders = (ctotal widths',ctotal heights')- rf1 borders (0,0) t+ rf1 borders (0,0) gt -- (x borders, y borders) -> (x,y) -> grid -> drawing rf1 borders loc@(i,j) t = case t of Null -> return nullPickFn Empty -> return nullPickFn- (Value (r,span,_)) -> do- let (Rect p0 p1) = mkRect borders loc span- p0'@(Point x0 y0) <- alignFillPoint p0- p1'@(Point x1 y1) <- alignFillPoint p1+ (Value (r,spn,_)) -> do+ let (Rect p0 p1) = mkRect borders loc spn+ (Point x0 y0) <- alignFillPoint p0+ (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- let pf p@(Point x y) = if y < (snd borders ! (j + height t1))+ let pf p@(Point _ y) = if y < (snd borders ! (j + height t1)) then pf1 p else pf2 p return pf (Beside t1 t2 _) -> do pf1 <- rf1 borders (i,j) t1 pf2 <- rf1 borders (i+width t1,j) t2- let pf p@(Point x y) = if x < (fst borders ! (i + width t1))+ let pf p@(Point x _) = if x < (fst borders ! (i + width t1)) then pf1 p else pf2 p return pf (Overlay t1 t2 _) -> do@@ -293,7 +287,7 @@ let pf p = pf1 p `mplus` pf2 p return pf - newpf pf x0 y0 = \ (Point x1 y1)-> pf (Point (x1-x0) (y1-y0))+ newpf pf x0 y0 (Point x1 y1) = pf (Point (x1-x0) (y1-y0)) -- (x borders, y borders) -> (x,y) -> (w,h) -- -> rectangle of grid[x..x+w, y..y+h]@@ -304,17 +298,17 @@ y1 = cheights ! y x2 = cwidths ! min (x+w) (snd $ bounds cwidths) y2 = cheights ! min (y+h) (snd $ bounds cheights)- mx = fst (bounds cwidths)- my = fst (bounds cheights)+ -- mx = fst (bounds cwidths)+ -- my = fst (bounds cheights) -- total size -> item sizes -> item weights -> new item sizes such that -- their sum == total size, and added size is proportional to weight addExtraSpace :: Double -> DArray -> DArray -> DArray- addExtraSpace size sizes weights =+ addExtraSpace size sizes weights' = if totalws == 0 then sizes else listArray (bounds sizes) sizes' where- ws = elems weights+ ws = elems weights' totalws = sum ws extra = size - sum (elems sizes) extras = map (*(extra/totalws)) ws
Graphics/Rendering/Chart/Layout.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Layout--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- This module glues together axes and plots to actually create a renderable@@ -20,10 +20,10 @@ -- -- These accessors are not shown in this API documentation. They have -- the same name as the field, but with the leading underscore--- dropped. Hence for data field _f::F in type D, they have type+-- dropped. Hence for data field @_f::F@ in type @D@, they have type -- -- @--- f :: Control.Lens.Lens' D F+-- f :: `Control.Lens.Lens'` D F -- @ -- {-# LANGUAGE ScopedTypeVariables #-}@@ -37,6 +37,7 @@ , LayoutPick(..) , StackedLayouts(..) , StackedLayout(..)+ -- , LegendItem haddock complains about this being missing, but from what? , MAxisFn , layoutToRenderable@@ -102,8 +103,7 @@ import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Grid import Control.Monad-import Control.Monad.Reader (local)-import Control.Lens+import Control.Lens hiding (at) import Data.Colour import Data.Colour.Names (white) import Data.Default.Class@@ -205,8 +205,8 @@ -- | Render the given 'Layout'. layoutToRenderable :: forall x y . (Ord x, Ord y) => Layout x y -> Renderable (LayoutPick x y y)-layoutToRenderable l = fillBackground (_layout_background l) - $ gridToRenderable (layoutToGrid l)+layoutToRenderable lxy = fillBackground (_layout_background lxy) + $ gridToRenderable (layoutToGrid lxy) where layoutToGrid l = aboveN [ tval $ titleToRenderable (_layout_margin l) (_layout_title_style l) (_layout_title l)@@ -215,7 +215,7 @@ , tval $ renderLegend l (getLegendItems l) ] - lm = _layout_margin l+ lm = _layout_margin lxy getLayoutXVals :: Layout x y -> [x] getLayoutXVals l = concatMap (fst . _plot_all_points) (_layout_plots l)@@ -229,7 +229,7 @@ renderLegend l legItems = gridToRenderable g where g = besideN [ tval $ mkLegend (_layout_legend l) (_layout_margin l) legItems- , weights (1,1) $ tval $ emptyRenderable ]+ , weights (1,1) $ tval emptyRenderable ] -- | Render the plot area of a 'Layout'. This consists of the -- actual plot area with all plots, the axis and their titles.@@ -244,8 +244,8 @@ lge_margin = _layout_margin l } where- xvals = [ x | p <- (_layout_plots l), x <- fst $ _plot_all_points p]- yvals = [ y | p <- (_layout_plots l), y <- snd $ _plot_all_points p]+ xvals = [ x | p <- _layout_plots l, x <- fst $ _plot_all_points p]+ yvals = [ y | p <- _layout_plots l, y <- snd $ _plot_all_points p] bAxis = mkAxis E_Bottom (overrideAxisVisibility l _layout_x_axis _layout_bottom_axis_visibility) xvals tAxis = mkAxis E_Top (overrideAxisVisibility l _layout_x_axis _layout_top_axis_visibility ) xvals@@ -253,21 +253,21 @@ rAxis = mkAxis E_Right (overrideAxisVisibility l _layout_y_axis _layout_right_axis_visibility ) yvals axes = (bAxis,lAxis,tAxis,rAxis) - plotsToRenderable l = Renderable {+ plotsToRenderable lxy = Renderable { minsize = return (0,0),- render = renderPlots l+ render = renderPlots lxy } -- | Render the plots of a 'Layout' to a plot area of given size. renderPlots :: Layout x y -> RectSize -> ChartBackend (PickFn (LayoutPick x y y))- renderPlots l sz@(w,h) = do- when (not (_layout_grid_last l)) (renderGrids sz axes)- withClipRegion (Rect (Point 0 0) (Point w h)) $ do- mapM_ rPlot (_layout_plots l)- when (_layout_grid_last l) (renderGrids sz axes)+ renderPlots lxy sz@(w,h) = do+ unless (_layout_grid_last lxy) (renderGrids sz axes)+ withClipRegion (Rect (Point 0 0) (Point w h)) $+ mapM_ rPlot (_layout_plots lxy)+ when (_layout_grid_last lxy) (renderGrids sz axes) return pickfn where- rPlot p = renderSinglePlot sz bAxis lAxis p+ rPlot = renderSinglePlot sz bAxis lAxis xr = (0, w) yr = (h, 0)@@ -286,8 +286,8 @@ (Just at,_) -> Just at (_,Just at) -> Just at (Nothing,Nothing) -> Nothing- mapx (AxisT _ _ rev ad) x = _axis_tropweiv ad (optPairReverse rev xr) x- mapy (AxisT _ _ rev ad) y = _axis_tropweiv ad (optPairReverse rev yr) y+ mapx (AxisT _ _ rev ad) = _axis_tropweiv ad (optPairReverse rev xr)+ mapy (AxisT _ _ rev ad) = _axis_tropweiv ad (optPairReverse rev yr) -- | Empty 'Layout' without title and plots. The background is white and -- the grid is drawn beneath all plots. There will be a legend. The top@@ -373,8 +373,8 @@ -- | Render the given 'LayoutLR'. layoutLRToRenderable :: forall x yl yr . (Ord x, Ord yl, Ord yr) => LayoutLR x yl yr -> Renderable (LayoutPick x yl yr)-layoutLRToRenderable l = fillBackground (_layoutlr_background l) - $ gridToRenderable (layoutLRToGrid l)+layoutLRToRenderable llr = fillBackground (_layoutlr_background llr) + $ gridToRenderable (layoutLRToGrid llr) where layoutLRToGrid l = aboveN [ tval $ titleToRenderable (_layoutlr_margin l) (_layoutlr_title_style l) (_layoutlr_title l)@@ -383,7 +383,7 @@ , tval $ renderLegendLR l (getLegendItemsLR l) ] - lm = _layoutlr_margin l+ lm = _layoutlr_margin llr getLayoutLRXVals :: LayoutLR x yl yr -> [x] getLayoutLRXVals l = concatMap deEither $ _layoutlr_plots l@@ -396,8 +396,8 @@ -- Left and right plot legend items are still separated. getLegendItemsLR :: LayoutLR x yl yr -> ([LegendItem],[LegendItem]) getLegendItemsLR l = (- concat [ _plot_legend p | (Left p ) <- (_layoutlr_plots l) ],- concat [ _plot_legend p | (Right p) <- (_layoutlr_plots l) ]+ concat [ _plot_legend p | (Left p ) <- _layoutlr_plots l ],+ concat [ _plot_legend p | (Right p) <- _layoutlr_plots l ] ) -- | Render the given 'LegendItem's for a 'LayoutLR'.@@ -405,9 +405,9 @@ renderLegendLR l (lefts,rights) = gridToRenderable g where g = besideN [ tval $ mkLegend (_layoutlr_legend l) (_layoutlr_margin l) lefts- , weights (1,1) $ tval $ emptyRenderable+ , weights (1,1) $ tval emptyRenderable , tval $ mkLegend (_layoutlr_legend l) (_layoutlr_margin l) rights ]- lm = _layoutlr_margin l+ -- lm = _layoutlr_margin l layoutLRPlotAreaToGrid :: forall x yl yr. (Ord x, Ord yl, Ord yr) => LayoutLR x yl yr @@ -432,17 +432,17 @@ rAxis = mkAxis E_Right (overrideAxisVisibility l _layoutlr_right_axis _layoutlr_right_axis_visibility) yvalsR axes = (bAxis,lAxis,tAxis,rAxis) - plotsToRenderable l = Renderable {+ plotsToRenderable llr = Renderable { minsize = return (0,0),- render = renderPlots l+ render = renderPlots llr } renderPlots :: LayoutLR x yl yr -> RectSize -> ChartBackend (PickFn (LayoutPick x yl yr))- renderPlots l sz@(w,h) = do- when (not (_layoutlr_grid_last l)) (renderGrids sz axes)- withClipRegion (Rect (Point 0 0) (Point w h)) $ do- mapM_ rPlot (_layoutlr_plots l)- when (_layoutlr_grid_last l) (renderGrids sz axes)+ renderPlots llr sz@(w,h) = do+ unless (_layoutlr_grid_last llr) (renderGrids sz axes)+ withClipRegion (Rect (Point 0 0) (Point w h)) $+ mapM_ rPlot (_layoutlr_plots llr)+ when (_layoutlr_grid_last llr) (renderGrids sz axes) return pickfn where rPlot (Left p) = renderSinglePlot sz bAxis lAxis p@@ -463,8 +463,8 @@ myats = case (lAxis,rAxis) of (Just at1,Just at2) -> Just (at1,at2) (_,_) -> Nothing- mapx (AxisT _ _ rev ad) x = _axis_tropweiv ad (optPairReverse rev xr) x- mapy (AxisT _ _ rev ad) y = _axis_tropweiv ad (optPairReverse rev yr) y+ mapx (AxisT _ _ rev ad) = _axis_tropweiv ad (optPairReverse rev xr)+ mapy (AxisT _ _ rev ad) = _axis_tropweiv ad (optPairReverse rev yr) ---------------------------------------------------------------------- @@ -509,7 +509,7 @@ mkGrid (sl, i) = titleR `wideAbove`- (addMarginsToGrid (lm,lm,lm,lm) $ mkPlotArea usedAxis)+ addMarginsToGrid (lm,lm,lm,lm) (mkPlotArea usedAxis) `aboveWide` (if showLegend then legendR else emptyRenderable) where@@ -567,7 +567,7 @@ legendItems :: StackedLayout x -> ([LegendItem], [LegendItem]) legendItems (StackedLayout l) = (getLegendItems l, [])- lebendItems (StackedLayoutLR l) = getLegendItemsLR l+ legendItems (StackedLayoutLR l) = getLegendItemsLR l noPickFn :: Renderable a -> Renderable () noPickFn = mapPickFn (const ())@@ -589,13 +589,13 @@ rs = tval $ spacer (r,0) titleToRenderable :: Double -> FontStyle -> String -> Renderable (LayoutPick x yl yr)-titleToRenderable lm fs "" = emptyRenderable+titleToRenderable _ _ "" = emptyRenderable titleToRenderable lm fs s = addMargins (lm/2,0,0,0) (mapPickFn LayoutPick_Title title) where title = label fs HTA_Centre VTA_Centre s mkLegend :: Maybe LegendStyle -> Double -> [LegendItem] -> Renderable (LayoutPick x yl yr)-mkLegend ls lm vals = case ls of+mkLegend mls lm vals = case mls of Nothing -> emptyRenderable Just ls -> case filter ((/="").fst) vals of [] -> emptyRenderable ;@@ -629,16 +629,16 @@ , besideN [er, er, er, btitle, er, er, er ] ] - er = tval $ emptyRenderable+ er = tval emptyRenderable plots = tval $ lge_plots lge - (tdata,tlbl,tstyle) = lge_taxis lge+ (tdata,_,_) = lge_taxis lge (bdata,blbl,bstyle) = lge_baxis lge (ldata,llbl,lstyle) = lge_laxis lge (rdata,rlbl,rstyle) = lge_raxis lge - (ttitle,_) = mktitle HTA_Centre VTA_Bottom 0 tlbl tstyle LayoutPick_XTopAxisTitle+ -- (ttitle,_) = mktitle HTA_Centre VTA_Bottom 0 tlbl tstyle LayoutPick_XTopAxisTitle (btitle,_) = mktitle HTA_Centre VTA_Top 0 blbl bstyle LayoutPick_XBottomAxisTitle (ltitle,lam) = mktitle HTA_Right VTA_Centre 270 llbl lstyle LayoutPick_YLeftAxisTitle (rtitle,ram) = mktitle HTA_Left VTA_Centre 270 rlbl rstyle LayoutPick_YRightAxisTitle@@ -663,10 +663,10 @@ -> (String -> LayoutPick x yl yr) -> ( Grid (Renderable (LayoutPick x yl yr)) , Grid (Renderable (LayoutPick x yl yr)) )- mktitle ha va rot lbl style pf = if lbl == "" then (er,er) else (label,gap)+ mktitle ha va rot lbl style pf = if lbl == "" then (er,er) else (labelG,gapG) where- label = tval $ mapPickFn pf $ rlabel style ha va rot lbl- gap = tval $ spacer (lge_margin lge,0)+ labelG = tval $ mapPickFn pf $ rlabel style ha va rot lbl+ gapG = tval $ spacer (lge_margin lge,0) -- | Render the grids of the given axis to a plot area of given size. renderGrids :: RectSize -> (Maybe (AxisT x), Maybe (AxisT yl), Maybe (AxisT x), Maybe (AxisT yr)) -> ChartBackend ()@@ -683,15 +683,15 @@ -- | Render a single set of plot data onto a plot area of given size using -- the given x and y axis. renderSinglePlot :: RectSize -> Maybe (AxisT x) -> Maybe (AxisT y) -> Plot x y -> ChartBackend ()-renderSinglePlot (w, h) (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p =+renderSinglePlot (w, h) (Just (AxisT _ _ xrev xaxis)) (Just (AxisT _ _ yrev yaxis)) p = let xr = optPairReverse xrev (0, w) yr = optPairReverse yrev (h, 0)- yrange = if yrev then (0, h) else (h, 0)+ -- yrange = if yrev then (0, h) else (h, 0) pmfn (x,y) = Point (mapv xr (_axis_viewport xaxis xr) x) (mapv yr (_axis_viewport yaxis yr) y)- mapv (min,max) _ LMin = min- mapv (min,max) _ LMax = max- mapv _ f (LValue v) = f v+ mapv lims _ LMin = fst lims+ mapv lims _ LMax = snd lims+ mapv _ f (LValue v) = f v in _plot_render p pmfn renderSinglePlot _ _ _ _ = return () @@ -713,7 +713,7 @@ where style = _laxis_style laxis rev = _laxis_reverse laxis- adata = (_laxis_override laxis) (_laxis_generate laxis vals)+ adata = _laxis_override laxis (_laxis_generate laxis vals) vis = _axis_visibility adata axisVisible = _axis_show_labels vis || _axis_show_line vis || _axis_show_ticks vis @@ -724,7 +724,7 @@ -> LayoutAxis z overrideAxisVisibility ly selAxis selVis = let vis = selVis ly- in (selAxis ly) { _laxis_override = (\ad -> ad { _axis_visibility = selVis ly }) + in (selAxis ly) { _laxis_override = (\ad -> ad { _axis_visibility = vis }) . _laxis_override (selAxis ly) }
Graphics/Rendering/Chart/Legend.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Legend--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Types and functions for handling the legend(s) on a chart. A legend@@ -20,14 +20,12 @@ legend_orientation ) where -import Control.Monad-import Data.List (nub, partition,intersperse)+import Data.List (partition,intersperse) import Control.Lens import Data.Default.Class 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 @@ -60,8 +58,8 @@ LORows n -> mkGrid n aboveG besideG LOCols n -> mkGrid n besideG aboveG - aboveG = aboveN.(intersperse ggap1)- besideG = besideN.(intersperse ggap1)+ aboveG = aboveN.intersperse ggap1+ besideG = besideN.intersperse ggap1 mkGrid n join1 join2 = join1 [ join2 (map rf ps1) | ps1 <- groups n ps ] @@ -72,20 +70,20 @@ where gpic = besideN $ intersperse ggap2 (map rp rfs) gtitle = tval $ lbl title- rp rfn = tval $ Renderable {+ rp rfn = tval Renderable { minsize = return (_legend_plot_size ls, 0), render = \(w,h) -> do - rfn (Rect (Point 0 0) (Point w h))+ _ <- rfn (Rect (Point 0 0) (Point w h)) return (\_-> Just title) } 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 = label (_legend_label_style ls) HTA_Left VTA_Centre groups :: Int -> [a] -> [[a]]-groups n [] = []-groups n vs = let (vs1,vs2) = splitAt n vs in vs1:groups n vs2+groups _ [] = []+groups n vs = let (vs1,vs2) = splitAt n vs in vs1:groups n vs2 join_nub :: [(String, a)] -> [(String, [a])] join_nub ((x,a1):ys) = case partition ((==x) . fst) ys of
Graphics/Rendering/Chart/Plot/Annotation.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Annotation--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Show textual annotations on a chart.@@ -22,22 +22,18 @@ 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.+-- can be rotated and styled. data PlotAnnotation x y = PlotAnnotation { _plot_annotation_hanchor :: HTextAnchor, _plot_annotation_vanchor :: VTextAnchor, _plot_annotation_angle :: Double,+ -- ^ Angle, in degrees, to rotate the annotation about the anchor point. _plot_annotation_style :: FontStyle, _plot_annotation_values :: [(x,y,String)] }@@ -47,14 +43,14 @@ toPlot p = Plot { _plot_render = renderAnnotation p, _plot_legend = [],- _plot_all_points = (map (\(x,_,_)->x) vs , map (\(_,y,_)->y) vs)+ _plot_all_points = (map (^._1) vs , map (^._2) vs) } where vs = _plot_annotation_values p renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> ChartBackend ()-renderAnnotation p pMap = withFontStyle style $ do +renderAnnotation p pMap = withFontStyle style $ mapM_ drawOne values where hta = _plot_annotation_hanchor p vta = _plot_annotation_vanchor p
Graphics/Rendering/Chart/Plot/AreaSpots.hs view
@@ -17,6 +17,7 @@ , area_spots_linethick , area_spots_linecolour , area_spots_fillcolour+ , area_spots_opacity , area_spots_max_radius , area_spots_values @@ -26,33 +27,22 @@ , area_spots_4d_title , area_spots_4d_linethick , area_spots_4d_palette+ , area_spots_4d_opacity , area_spots_4d_max_radius , area_spots_4d_values ) where -import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Geometry hiding (scale, x0, y0) import Graphics.Rendering.Chart.Drawing import Graphics.Rendering.Chart.Plot.Types import Graphics.Rendering.Chart.Axis import Control.Lens-import Data.Colour+import Data.Colour hiding (over) import Data.Colour.Names import Data.Default.Class import Control.Monad ---- stuff that belongs in Data.Tuple-fst3 (a,_,_) = a-snd3 (_,a,_) = a-thd3 (_,_,a) = a--fst4 (a,_,_,_) = a-snd4 (_,a,_,_) = a-thd4 (_,_,a,_) = a-fth4 (_,_,_,a) = a-- -- | A collection of unconnected spots, with x,y position, and an -- independent z value to be represented by the area of the spot. data AreaSpots z x y = AreaSpots@@ -83,13 +73,13 @@ 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) )+ , _plot_all_points = ( map (^._1) (_area_spots_values p)+ , map (^._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)+ forM_ (scaleMax (_area_spots_max_radius p^(2::Integer)) (_area_spots_values p)) (\ (x,y,z)-> do let radius = sqrt z@@ -105,23 +95,21 @@ ) where scaleMax :: PlotValue z => Double -> [(x,y,z)] -> [(x,y,Double)]- scaleMax n points = let largest = maximum (map (toValue . thd3) points)+ scaleMax n points = let largest = maximum (map (^._3.to toValue) points) scale v = n * toValue v / largest- in map (\ (x,y,z) -> (x,y, scale z)) points+ in over (mapped._3) scale points renderSpotLegend :: AreaSpots z x y -> Rect -> ChartBackend ()-renderSpotLegend p r@(Rect p1 p2) = do+renderSpotLegend p (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 psSpot = filledCircles radius $- flip withOpacity - (_area_spots_opacity p) $- _area_spots_fillcolour p- drawPoint psSpot centre- let psSpot = hollowCircles radius- (_area_spots_linethick p)- (_area_spots_linecolour p)+ psSpot = filledCircles radius $ withOpacity + (_area_spots_fillcolour p)+ (_area_spots_opacity p)+ psOutline = hollowCircles radius (_area_spots_linethick p)+ (_area_spots_linecolour p) drawPoint psSpot centre+ drawPoint psOutline centre where linearInterpolate (Point x0 y0) (Point x1 y1) = Point (x0 + abs(x1-x0)/2) (y0 + abs(y1-y0)/2)@@ -158,22 +146,22 @@ 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 (^._1) (_area_spots_4d_values p)+ , map (^._2) (_area_spots_4d_values p) ) } renderAreaSpots4D :: (PlotValue z, PlotValue t, Show t) => AreaSpots4D z t x y -> PointMapFn x y -> ChartBackend () renderAreaSpots4D p pmap = - forM_ (scaleMax ((_area_spots_4d_max_radius p)^2)+ forM_ (scaleMax (_area_spots_4d_max_radius p^(2::Integer)) (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 colour = _area_spots_4d_palette p !! t let psSpot = filledCircles radius $- flip withOpacity (_area_spots_4d_opacity p) $ colour+ withOpacity colour (_area_spots_4d_opacity p) drawPoint psSpot (pmap (LValue x, LValue y)) let psOutline = hollowCircles radius (_area_spots_4d_linethick p)@@ -183,9 +171,9 @@ where scaleMax :: (PlotValue z, PlotValue t, Show t) => Double -> Int -> [(x,y,z,t)] -> [(x,y,Double,Int)]- scaleMax n c points = let largest = maximum (map (toValue . thd4) points)+ scaleMax n c points = let largest = maximum (map (^._3.to toValue) points) scale v = n * toValue v / largest- colVals = map (toValue . fth4) points+ colVals = map (^._4.to toValue) points colMin = minimum colVals colMax = maximum colVals select t = min (c-1) $ @@ -196,18 +184,15 @@ points renderSpotLegend4D :: AreaSpots4D z t x y -> Rect -> ChartBackend ()-renderSpotLegend4D p r@(Rect p1 p2) = do+renderSpotLegend4D p (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 psSpot = filledCircles radius $- flip withOpacity- (_area_spots_4d_opacity p) $- head $ _area_spots_4d_palette p+ palCol = head $ _area_spots_4d_palette p+ psSpot = filledCircles radius $ withOpacity palCol+ (_area_spots_4d_opacity p)+ psOutline = hollowCircles radius (_area_spots_4d_linethick p)+ (opaque palCol) drawPoint psSpot centre- let psOutline = hollowCircles radius- (_area_spots_4d_linethick p)- (opaque $- head (_area_spots_4d_palette p)) drawPoint psOutline centre where linearInterpolate (Point x0 y0) (Point x1 y1) =
Graphics/Rendering/Chart/Plot/Bars.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Bars--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Bar Charts@@ -31,14 +31,12 @@ import Control.Lens import Control.Monad import Data.List(nub,sort)-import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Geometry hiding (x0, y0) 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.Colour.Names (black) import Data.Default.Class class PlotValue a => BarsPlotValue a where@@ -137,42 +135,41 @@ } renderPlotBars :: (BarsPlotValue y) => PlotBars x y -> PointMapFn x y -> ChartBackend ()-renderPlotBars p pmap = case (_plot_bars_style p) of+renderPlotBars p pmap = case _plot_bars_style p of BarsClustered -> forM_ vals clusteredBars BarsStacked -> forM_ vals stackedBars where clusteredBars (x,ys) = do- forM_ (zip3 [0,1..] ys styles) $ \(i, y, (fstyle,_)) -> do- 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- withLineStyle lstyle $ do- p <- alignStrokePath (barPath (offset i) x yref0 y)- strokePath p+ forM_ (zip3 [0,1..] ys styles) $ \(i, y, (fstyle,_)) -> + withFillStyle fstyle $ + alignFillPath (barPath (offset i) x yref0 y)+ >>= fillPath+ forM_ (zip3 [0,1..] ys styles) $ \(i, y, (_,mlstyle)) -> + whenJust mlstyle $ \lstyle -> + withLineStyle lstyle $ + alignStrokePath (barPath (offset i) x yref0 y)+ >>= strokePath - 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) = do let y2s = zip (yref0:stack ys) (stack ys)- let ofs = case (_plot_bars_alignment p) of {- BarsLeft -> 0 ;- BarsRight -> (-width) ;- BarsCentered -> (-width/2)- }- forM_ (zip y2s styles) $ \((y0,y1), (fstyle,_)) -> do- withFillStyle fstyle $ do- p <- alignFillPath (barPath ofs x y0 y1)- fillPath p- forM_ (zip y2s styles) $ \((y0,y1), (_,mlstyle)) -> do- whenJust mlstyle $ \lstyle -> do- withLineStyle lstyle $ do- p <- alignStrokePath (barPath ofs x y0 y1)- strokePath p+ let ofs = case _plot_bars_alignment p of+ BarsLeft -> 0+ BarsRight -> -width+ BarsCentered -> -(width/2)+ forM_ (zip y2s styles) $ \((y0,y1), (fstyle,_)) -> + withFillStyle fstyle $ + alignFillPath (barPath ofs x y0 y1)+ >>= fillPath+ forM_ (zip y2s styles) $ \((y0,y1), (_,mlstyle)) -> + whenJust mlstyle $ \lstyle -> + withLineStyle lstyle $ + alignStrokePath (barPath ofs x y0 y1)+ >>= strokePath barPath xos x y0 y1 = do let (Point x' y') = pmap' (x,y1)@@ -183,10 +180,10 @@ 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+ BarsFixWidth width' -> width' styles = _plot_bars_item_styles p minXInterval = let diffs = zipWith (-) (tail mxs) mxs@@ -197,7 +194,7 @@ xs = fst (allBarPoints p) mxs = nub $ sort $ map mapX xs - nys = maximum [ length ys | (x,ys) <- vals ]+ nys = maximum [ length ys | (_,ys) <- vals ] pmap' = mapXY pmap mapX x = p_x (pmap' (x,barsReference))@@ -207,7 +204,7 @@ 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@@ -215,12 +212,11 @@ y0 = _plot_bars_reference p stack :: (BarsPlotValue y) => [y] -> [y]-stack ys = scanl1 barsAdd ys-+stack = scanl1 barsAdd renderPlotLegendBars :: (FillStyle,Maybe LineStyle) -> Rect -> ChartBackend ()-renderPlotLegendBars (fstyle,mlstyle) r@(Rect p1 p2) = do- withFillStyle fstyle $ do+renderPlotLegendBars (fstyle,_) r = + withFillStyle fstyle $ fillPath (rectPath r) $( makeLenses ''PlotBars )
Graphics/Rendering/Chart/Plot/Candle.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Candle--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Candlestick charts for financial plotting@@ -24,17 +24,15 @@ plot_candle_values, ) where -import Control.Lens+import Control.Lens hiding (op) import Data.Monoid -import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Geometry hiding (close) 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.Colour.Names (white, blue) import Data.Default.Class -- | Value defining a financial interval: opening and closing prices, with@@ -78,7 +76,7 @@ pts = _plot_candle_values p renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> ChartBackend ()-renderPlotCandle p pmap = do+renderPlotCandle p pmap = mapM_ (drawCandle p . candlemap) (_plot_candle_values p) where candlemap (Candle x lo op mid cl hi) =@@ -90,6 +88,7 @@ (Point _ hi') = pmap' (x,hi) pmap' = mapXY pmap +drawCandle :: PlotCandle x y -> Candle Double Double -> ChartBackend () drawCandle ps (Candle x lo open mid close hi) = do let tl = _plot_candle_tick_length ps let wd = _plot_candle_width ps@@ -98,7 +97,7 @@ -- the pixel coordinate system is inverted wrt the value coords. when f $ withFillStyle (if open >= close then _plot_candle_rise_fill_style ps- else _plot_candle_fall_fill_style ps) $ do+ else _plot_candle_fall_fill_style ps) $ fillPath $ moveTo' (x-wd) open <> lineTo' (x-wd) close <> lineTo' (x+wd) close@@ -122,16 +121,16 @@ <> moveTo' (x-tl) hi <> lineTo' (x+tl) hi - when (ct > 0) $ do strokePath $ moveTo' (x-ct) mid- <> lineTo' (x+ct) mid+ when (ct > 0) $ strokePath $ moveTo' (x-ct) mid+ <> lineTo' (x+ct) mid 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}- (Candle ((p_x p1 + p_x p2)*2/3) lo close mid open hi)+renderPlotLegendCandle pc (Rect p1 p2) = do+ drawCandle pc2 (Candle (xwid*1/4) lo open mid close hi)+ drawCandle pc2 (Candle (xwid*2/3) lo close mid open hi) where+ pc2 = pc { _plot_candle_width = 2 }+ xwid = p_x p1 + p_x p2 lo = max (p_y p1) (p_y p2) mid = (p_y p1 + p_y p2)/2 hi = min (p_y p1) (p_y p2)
Graphics/Rendering/Chart/Plot/ErrBars.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.ErrBars--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Plot series of points with associated error bars.@@ -30,11 +30,9 @@ 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.Colour.Names (blue) import Data.Default.Class -- | Value for holding a point with associated error bounds for each axis.@@ -79,7 +77,7 @@ pts = _plot_errbars_values p renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> ChartBackend ()-renderPlotErrBars p pmap = do+renderPlotErrBars p pmap = mapM_ (drawErrBar.epmap) (_plot_errbars_values p) where epmap (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) =@@ -90,10 +88,11 @@ drawErrBar = drawErrBar0 p pmap' = mapXY pmap +drawErrBar0 :: PlotErrBars x y -> ErrPoint Double Double -> ChartBackend () 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- withLineStyle (_plot_errbars_line_style ps) $ do+ withLineStyle (_plot_errbars_line_style ps) $ strokePath $ moveTo' (xl-oh) y <> lineTo' (xh+oh) y <> moveTo' x (yl-oh)@@ -108,14 +107,15 @@ <> lineTo' (x+tl) yh 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)+renderPlotLegendErrBars p (Rect p1 p2) = do+ drawErrBar (symErrPoint (p_x p1) y dx dx)+ drawErrBar (symErrPoint ((p_x p1 + p_x p2)/2) y dx dx)+ drawErrBar (symErrPoint (p_x p2) y dx dx) where drawErrBar = drawErrBar0 p dx = min ((p_x p2 - p_x p1)/6) ((p_y p2 - p_y p1)/2)+ y = (p_y p1 + p_y p2)/2 {-# DEPRECATED defaultPlotErrBars "Use the according Data.Default instance!" #-} defaultPlotErrBars :: PlotErrBars x y
Graphics/Rendering/Chart/Plot/FillBetween.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.FillBetween--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Plots that fill the area between two lines.@@ -22,10 +22,8 @@ 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 @@ -47,22 +45,27 @@ } renderPlotFillBetween :: PlotFillBetween x y -> PointMapFn x y -> ChartBackend ()-renderPlotFillBetween p pmap =- renderPlotFillBetween' p (_plot_fillbetween_values p) pmap+renderPlotFillBetween p =+ renderPlotFillBetween' p (_plot_fillbetween_values p) -renderPlotFillBetween' p [] _ = return ()+renderPlotFillBetween' :: + PlotFillBetween x y + -> [(a, (b, b))]+ -> ((Limit a, Limit b) -> Point)+ -> ChartBackend ()+renderPlotFillBetween' _ [] _ = return () 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 ]+ (p0:p1s) = map pmap' [ (x,y1) | (x,(y1,_)) <- vs ]+ p2s = map pmap' [ (x,y2) | (x,(_,y2)) <- vs ] renderPlotLegendFill :: PlotFillBetween x y -> Rect -> ChartBackend () renderPlotLegendFill p r = - withFillStyle (_plot_fillbetween_style p) $ do+ withFillStyle (_plot_fillbetween_style p) $ fillPath (rectPath r) plotAllPointsFillBetween :: PlotFillBetween x y -> ([x],[y])
Graphics/Rendering/Chart/Plot/Hidden.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Hidden--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Plots that don't show, but occupy space so as to effect axis@@ -11,16 +11,16 @@ module Graphics.Rendering.Chart.Plot.Hidden( PlotHidden(..),+ + plot_hidden_x_values,+ plot_hidden_y_values ) where 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.+-- | Value defining some hidden x and y values. The values are+-- not displayed, but they still affect axis scaling. data PlotHidden x y = PlotHidden { _plot_hidden_x_values :: [x], _plot_hidden_y_values :: [y]
Graphics/Rendering/Chart/Plot/Lines.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Lines--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Line plots@@ -24,10 +24,9 @@ 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.Names (blue) import Data.Default.Class -- | Value defining a series of (possibly disjointed) lines,@@ -65,7 +64,7 @@ drawLines mapfn pts = alignStrokePoints (map mapfn pts) >>= strokePointPath renderPlotLegendLines :: PlotLines x y -> Rect -> ChartBackend ()-renderPlotLegendLines p r@(Rect p1 p2) = +renderPlotLegendLines p (Rect p1 p2) = withLineStyle (_plot_lines_style p) $ do let y = (p_y p1 + p_y p2) / 2 ps <- alignStrokePoints [Point (p_x p1) y, Point (p_x p2) y]
Graphics/Rendering/Chart/Plot/Pie.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Pie --- Copyright : (c) Tim Docker 2008 +-- Copyright : (c) Tim Docker 2008, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- A basic pie chart. @@ -15,7 +15,7 @@ -- values = [...] -- layout :: PieLayout -- layout = pie_plot ^: pie_data ^= values --- $ defaultPieLayout +-- $ def -- renderable = toRenderable layout -- @ {-# LANGUAGE TemplateHaskell #-} @@ -48,21 +48,20 @@ ) where -- original code thanks to Neal Alexander -import Data.List -import Data.Bits -import Control.Lens hiding (moveTo) +-- see ../Drawing.hs for why we do not use hiding (moveTo) for +-- lens < 4 +import Control.Lens import Data.Colour -import Data.Colour.Names (black, white) +import Data.Colour.Names (white) import Data.Monoid import Data.Default.Class import Control.Monad -import Graphics.Rendering.Chart.Geometry +import Graphics.Rendering.Chart.Geometry hiding (moveTo) +import qualified Graphics.Rendering.Chart.Geometry as G 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, @@ -117,7 +116,7 @@ , _pie_title = "" , _pie_title_style = def { _font_size = 15 , _font_weight = FontWeightBold } - , _pie_plot = defaultPieChart + , _pie_plot = def , _pie_margin = 10 } @@ -145,7 +144,7 @@ extraSpace :: PieChart -> ChartBackend (Double, Double) extraSpace p = do - textSizes <- mapM textDimension (map _pitem_label (_pie_data p)) + textSizes <- mapM (textDimension . _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) @@ -160,25 +159,27 @@ 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 + -- 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 center = Point (w/2) (h/2) + let radius = min (w - 2*extraw) (h - 2*extrah) / 2 foldM_ (paint center radius) (_pie_start_angle p) (zip (_pie_colors p) content) return nullPickFn where - p1 = Point 0 0 - p2 = Point w h + -- 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 ] + in [ pitem{_pitem_value=_pitem_value pitem/total} + | pitem <- _pie_data p ] paint :: Point -> Double -> Double -> (AlphaColour Double, PieItem) -> 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 @@ -190,33 +191,33 @@ where pieLabel :: String -> Double -> Double -> ChartBackend () - pieLabel name angle offset = do - withFontStyle (_pie_label_style p) $ do + pieLabel name angle offset = + withFontStyle (_pie_label_style p) $ withLineStyle (_pie_label_line_style p) $ do let p1 = ray angle (radius+label_rgap+label_rlength+offset) - p1a <- alignStrokePoint $ p1 - (tw,th) <- textDimension name + p1a <- alignStrokePoint p1 + (tw,_) <- 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 + strokePath $ G.moveTo p0 <> lineTo p1a - <> lineTo' (p_x p1a + (offset' (tw + label_rgap))) (p_y p1a) + <> lineTo' (p_x p1a + offset' (tw + label_rgap)) (p_y p1a) - let p2 = p1 `pvadd` (Vector (offset' label_rgap) 0) + let p2 = p1 `pvadd` Vector (offset' label_rgap) 0 drawTextA anchor VTA_Bottom p2 name 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) + pieSlice (Point x y) arc1 arc2 pColor = do + let path = arc' x y radius (radian arc1) (radian arc2) <> lineTo' x y <> lineTo' x y <> close - withFillStyle (FillStyleSolid color) $ do + withFillStyle (FillStyleSolid pColor) $ fillPath path - withLineStyle (def { _line_color = withOpacity white 0.1 }) $ do + withLineStyle (def { _line_color = withOpacity white 0.1 }) $ strokePath path ray :: Double -> Double -> Point @@ -226,13 +227,15 @@ y' = y + (sin' * x'') cos' = (cos . radian) angle sin' = (sin . radian) angle - x'' = ((x + r) - x) + -- TODO: is x'' defined in this way to try and avoid + -- numerical rounding? + x'' = (x + r) - x x = p_x center y = p_y center radian = (*(pi / 180.0)) - +label_rgap, label_rlength :: Double label_rgap = 5 label_rlength = 15
Graphics/Rendering/Chart/Plot/Points.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Points--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Functions to plot sets of points, marked in various styles.@@ -23,10 +23,7 @@ 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@@ -47,20 +44,21 @@ pts = _plot_points_values p renderPlotPoints :: PlotPoints x y -> PointMapFn x y -> ChartBackend ()-renderPlotPoints p pmap = do+renderPlotPoints p pmap = mapM_ (drawPoint ps . pmap') (_plot_points_values p) where pmap' = mapXY pmap- ps = (_plot_points_style p)+ ps = _plot_points_style p 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))+renderPlotLegendPoints p (Rect p1 p2) = do+ drawPoint ps (Point (p_x p1) y)+ drawPoint ps (Point ((p_x p1 + p_x p2)/2) y)+ drawPoint ps (Point (p_x p2) y) where- ps = (_plot_points_style p)+ ps = _plot_points_style p+ y = (p_y p1 + p_y p2)/2 {-# DEPRECATED defaultPlotPoints "Use the according Data.Default instance!" #-} defaultPlotPoints :: PlotPoints x y
Graphics/Rendering/Chart/Plot/Types.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Types--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- Datatypes and functions common to the implementation of the various@@ -24,11 +24,7 @@ import Graphics.Rendering.Chart.Geometry import Graphics.Rendering.Chart.Drawing-import Graphics.Rendering.Chart.Renderable-import Control.Monad import Control.Lens-import Data.Colour-import Data.Colour.Names -- | Interface to control plotting on a 2D area. data Plot x y = Plot {@@ -68,7 +64,7 @@ ---------------------------------------------------------------------- -mapXY :: PointMapFn x y -> ((x,y) -> Point)+mapXY :: PointMapFn x y -> (x,y) -> Point mapXY f (x,y) = f (LValue x, LValue y) ----------------------------------------------------------------------
Graphics/Rendering/Chart/Renderable.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Renderable--- Copyright : (c) Tim Docker 2006+-- Copyright : (c) Tim Docker 2006, 2014 -- License : BSD-style (see chart/COPYRIGHT) -- -- This module contains the definition of the 'Renderable' type, which@@ -14,6 +14,8 @@ Renderable(..), ToRenderable(..), PickFn,+ Rectangle(..),+ RectCornerStyle(..), rectangleToRenderable, @@ -38,7 +40,6 @@ import Control.Monad import Control.Lens-import Data.List ( nub, transpose, sort ) import Data.Monoid import Data.Default.Class @@ -50,7 +51,7 @@ -- -- Perhaps it might be generalised from Maybe a to -- (MonadPlus m ) => m a in the future.-type PickFn a = Point -> (Maybe a)+type PickFn a = Point -> Maybe a nullPickFn :: PickFn a nullPickFn = const Nothing@@ -59,11 +60,11 @@ -- graphic element. data Renderable a = Renderable { - -- | A Cairo action to calculate a minimum size.+ -- | Calculate the minimum size of the renderable. minsize :: ChartBackend RectSize, - -- | A Cairo action for drawing it within a rectangle.- -- The rectangle is from the origin to the given point.+ -- | Draw the renderable with a rectangle, which covers+ -- the origin to a given point. -- -- The resulting "pick" function maps a point in the image to a value. render :: RectSize -> ChartBackend (PickFn a)@@ -91,7 +92,7 @@ -- | Replace the pick function of a renderable with another. setPickFn :: PickFn b -> Renderable a -> Renderable b-setPickFn pickfn r = r{ render = \sz -> do { render r sz; return pickfn; } }+setPickFn pickfn r = r{ render = \sz -> render r sz >> return pickfn } -- | Map a function over the result of a renderable's pickfunction, keeping only 'Just' results. mapMaybePickFn :: (a -> Maybe b) -> Renderable a -> Renderable b@@ -112,14 +113,14 @@ (w,h) <- minsize rd return (w+l+r,h+t+b) - rf (w,h) = do+ rf (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+ 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 :: FillStyle -> Renderable a -> Renderable a@@ -148,34 +149,42 @@ 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.+-- of rotation is in degrees, measured clockwise from the horizontal. rlabel :: FontStyle -> HTextAnchor -> VTextAnchor -> Double -> String -> Renderable String rlabel fs hta vta rot s = Renderable { minsize = mf, render = rf } where mf = withFontStyle fs $ do ts <- textSize s- let (w,h) = (textSizeWidth ts, textSizeHeight ts)- return (w*acr+h*asr,w*asr+h*acr)+ let sz = (textSizeWidth ts, textSizeHeight ts)+ return (xwid sz, ywid sz)+ 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+ descent = textSizeDescent ts+ + xadj HTA_Left = xwid sz/2+ xadj HTA_Centre = w0/2+ xadj HTA_Right = w0 - xwid sz/2+ + yadj VTA_Top = ywid sz/2+ yadj VTA_Centre = h0/2+ yadj VTA_Bottom = h0 - ywid sz/2+ yadj VTA_BaseLine = h0 - ywid sz/2 + descent*acr++ withTranslation (Point 0 (-descent)) $ + withTranslation (Point (xadj hta) (yadj vta)) $ 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- yadj (w,h) VTA_Top y1 y2 = y1 +(w*asr+h*acr)/2- yadj (w,h) VTA_Centre y1 y2 = (y1+y2)/2- yadj (w,h) VTA_Bottom y1 y2 = y2 - (w*asr+h*acr)/2-+ rot' = rot / 180 * pi (cr,sr) = (cos rot', sin rot') (acr,asr) = (abs cr, abs sr) + xwid (w,h) = w*acr + h*asr+ ywid (w,h) = w*asr + h*acr+ ---------------------------------------------------------------------- -- Rectangles @@ -190,10 +199,6 @@ _rect_cornerStyle :: RectCornerStyle } -{-# DEPRECATED defaultRectangle "Use the according Data.Default instance!" #-}-defaultRectangle :: Rectangle-defaultRectangle = def- instance Default Rectangle where def = Rectangle { _rect_minsize = (0,0)@@ -214,12 +219,12 @@ maybeM () (stroke sz) (_rect_lineStyle rectangle) return nullPickFn - fill sz fs = do- withFillStyle fs $ do+ fill sz fs = + withFillStyle fs $ fillPath $ strokeRectangleP sz (_rect_cornerStyle rectangle) - stroke sz ls = do- withLineStyle ls $ do+ stroke sz ls = + withLineStyle ls $ strokePath $ strokeRectangleP sz (_rect_cornerStyle rectangle) strokeRectangleP (x2,y2) RCornerSquare =
Graphics/Rendering/Chart/SparkLine.hs view
@@ -1,27 +1,29 @@ --------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Sparkline--- Copyright : (c) Hitesh Jasani, 2008, Malcolm Wallace 2011+-- Copyright : (c) Hitesh Jasani, 2008, Malcolm Wallace 2011, Tim Docker 2014 -- License : BSD3 ----- Created : 2008-02-26--- Modified : 2011-02-11--- Version : 0.2------ Sparklines implementation in Haskell. Sparklines are--- mini graphs inspired by Edward Tufte.+-- Sparklines are mini graphs inspired by Edward Tufte; see+-- <http://www.edwardtufte.com/bboard/q-and-a-fetch-msg?msg_id=0001OR>+-- and+-- <http://en.wikipedia.org/wiki/Sparkline> for more information. -- -- The original implementation (by Hitesh Jasani) used the gd -- package as a backend renderer, and is still available at--- http://hackage.haskell.org/package/hsparklines--- The present version uses Cairo as its renderer, and integrates with+-- <http://hackage.haskell.org/package/hsparklines>.+--+-- The present version integrates with -- the Chart package, in the sense that Sparklines are just another--- kind of (ToRenderable a => a), so can be composed into grids etc.+-- kind of (@ToRenderable a => a@), so they can be composed into grids+-- and used with the rest of Chart. -- -- > dp :: [Double] -- > dp = [24,21,32.3,24,15,34,43,55,57,72,74,75,73,72,55,44] -- >--- > sparkLineToPNG "bar_spark.png" (SparkLine barSpark dp)+-- > sl = SparkLine barSpark dp+-- > fopts = FileOptions (sparkSize sl) PNG+-- > renderableToFile fopts (sparkLineToRenderable sl) "bar_spark.png" -- > --------------------------------------------------------------- @@ -90,6 +92,7 @@ barSpark :: SparkOptions barSpark = smoothSpark { so_smooth=False } +-- | Create a renderable from a SparkLine. sparkLineToRenderable :: SparkLine -> Renderable () sparkLineToRenderable sp = Renderable { minsize = let (w,h) = sparkSize sp in return (fromIntegral w , fromIntegral h)@@ -109,10 +112,11 @@ | otherwise = 2 in w +-- | Return the width and height of the SparkLine. sparkSize :: SparkLine -> (Int,Int) sparkSize s = (sparkWidth s, so_height (sl_options s)) --- | Render a SparkLine to a drawing surface using cairo.+-- | Render a SparkLine to a drawing surface. renderSparkLine :: SparkLine -> ChartBackend (PickFn ()) renderSparkLine SparkLine{sl_options=opt, sl_data=ds} = let w = 4 + (so_step opt) * (length ds - 1) + extrawidth