Chart 0.7 → 0.8
raw patch · 11 files changed
+475/−225 lines, 11 filesdep +timedep −old-time
Dependencies added: time
Dependencies removed: old-time
Files
- Chart.cabal +4/−3
- Graphics/Rendering/Chart.hs +14/−4
- Graphics/Rendering/Chart/Axis.hs +90/−87
- Graphics/Rendering/Chart/Gtk.hs +1/−3
- Graphics/Rendering/Chart/Layout.hs +16/−9
- Graphics/Rendering/Chart/Pie.hs +154/−0
- Graphics/Rendering/Chart/Plot.hs +4/−1
- Graphics/Rendering/Chart/Renderable.hs +18/−24
- Graphics/Rendering/Chart/Simple.hs +18/−4
- Graphics/Rendering/Chart/Types.hs +42/−35
- tests/test.hs +114/−55
Chart.cabal view
@@ -1,5 +1,5 @@ Name: Chart-Version: 0.7+Version: 0.8 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006@@ -19,7 +19,7 @@ library if flag(splitbase)- Build-depends: base >= 3, old-locale, old-time, mtl+ Build-depends: base >= 3, old-locale, time, mtl else Build-depends: base < 3 Build-depends: gtk >= 0.9.11, cairo >= 0.9.11, mtl@@ -31,6 +31,7 @@ Graphics.Rendering.Chart.Renderable, Graphics.Rendering.Chart.Axis, Graphics.Rendering.Chart.Layout,- Graphics.Rendering.Chart.Plot+ Graphics.Rendering.Chart.Plot,+ Graphics.Rendering.Chart.Pie, Graphics.Rendering.Chart.Simple
Graphics/Rendering/Chart.hs view
@@ -24,6 +24,7 @@ ToRenderable(..), Layout1(..), Axis(..),+ LinearAxisParams(..), Plot(..), ToPlot(..), PlotPoints(..),@@ -32,10 +33,14 @@ PlotFillBetween(..), HAxis(..), VAxis(..),+ LegendStyle(..), Rect(..), Point(..), Color(..), ErrPoint(..),+ PieChart(..),+ PieLayout(..),+ PieItem(..), defaultAxisLineStyle, defaultPlotLineStyle, defaultAxis, @@ -44,6 +49,11 @@ defaultPlotLines, defaultPlotFillBetween, defaultLayout1,+ defaultLinearAxis,+ defaultPieLayout,+ defaultPieChart,+ defaultPieItem,+ defaultLegendStyle, filledCircles, hollowCircles, exes, plusses, stars,@@ -52,7 +62,6 @@ solidLine, dashedLine, solidFillStyle,- fontStyle, independentAxes, linkedAxes, linkedAxes',@@ -63,13 +72,13 @@ autoScaledLogAxis', timeAxis, autoTimeAxis,- formatTime, days, months, years, renderableToPNGFile, renderableToPDFFile, renderableToPSFile,- doubleFromClockTime,- clockTimeFromDouble,+ renderableToSVGFile,+ doubleFromLocalTime,+ localTimeFromDouble, CairoLineStyle(..), CairoFillStyle(..), CairoFontStyle(..)@@ -80,3 +89,4 @@ import Graphics.Rendering.Chart.Layout import Graphics.Rendering.Chart.Axis import Graphics.Rendering.Chart.Plot+import Graphics.Rendering.Chart.Pie
Graphics/Rendering/Chart/Axis.hs view
@@ -7,7 +7,7 @@ module Graphics.Rendering.Chart.Axis where import qualified Graphics.Rendering.Cairo as C-import System.Time+import Data.Time import System.Locale (defaultTimeLocale) import Control.Monad import Data.List@@ -113,9 +113,12 @@ renderAxis :: AxisT -> Rect -> CRender () renderAxis at@(AxisT et a) rect = do+ let ls = axis_line_style a preserveCState $ do- setLineStyle (axis_line_style a)+ setLineStyle ls{line_cap=C.LineCapSquare} strokeLines [Point sx sy,Point ex ey]+ preserveCState $ do+ setLineStyle ls{line_cap=C.LineCapButt} mapM_ drawTick (axis_ticks a) preserveCState $ do setFontStyle (axis_label_style a)@@ -195,12 +198,7 @@ explicitAxis :: Maybe Axis -> AxisFn explicitAxis ma _ = ma -linearTicks r = (major, minor)- where- major = steps 5 r- minor = steps 50 (fromRational (minimum major),fromRational (maximum major))--autoAxis labelf transform (rlabelvs, rtickvs) a = Just axis+autoAxis labelf transform (rlabelvs, rtickvs, rgridvs) a = Just axis where axis = a { axis_viewport=newViewport,@@ -218,27 +216,55 @@ gridvs = case (axis_grid a) of [] -> []- _ -> labelvs+ _ -> map fromRational rgridvs +data LinearAxisParams = LinearAxisParams {+ -- | The function used to show the axes labels+ la_labelf :: Double -> String,++ -- | The target number of labels to be shown+ la_nLabels :: Int,++ -- | The target number of ticks to be shown+ la_nTicks :: Int,++ -- | If True, the grid is shown at the label values, otherwise the+ -- otherwise the grid is shown at the tick values+ la_gridAtMinor :: Bool+}++defaultLinearAxis = LinearAxisParams {+ la_labelf = showD,+ la_nLabels = 5,+ la_nTicks = 50,+ la_gridAtMinor = False+}+ -- | Generate a linear axis automatically. -- The supplied axis is used as a template, with the viewport, ticks, labels -- and grid set appropriately for the data displayed against that axies. -- The resulting axis will only show a grid if the template has some grid -- values.-autoScaledAxis' :: (Double->String) -> Axis -> AxisFn-autoScaledAxis' labelf a ps0 = autoAxis labelf vmap (linearTicks (range ps)) a+autoScaledAxis' :: LinearAxisParams -> Axis -> AxisFn+autoScaledAxis' lap a ps0 = autoAxis (la_labelf lap) vmap (labelvs,tickvs,gridvs) a where ps = filter isValidNumber ps0 (min,max) = (minimum ps,maximum ps) range [] = (0,1) range _ | min == max = (min-0.5,min+0.5) | otherwise = (min,max)+ labelvs = steps (fromIntegral (la_nLabels lap)) r+ tickvs = steps (fromIntegral (la_nTicks lap)) (fromRational (minimum labelvs),fromRational (maximum labelvs))+ gridvs = case la_gridAtMinor lap of+ False -> labelvs+ True -> tickvs+ r = range ps -- | Generate a linear axis automatically. -- Same as autoScaledAxis', but with labels generated with "showD" -- (showD is show for doubles, but with any trailing ".0" removed) autoScaledAxis :: Axis -> AxisFn-autoScaledAxis = autoScaledAxis' showD+autoScaledAxis = autoScaledAxis' defaultLinearAxis showD x = case reverse $ show x of '0':'.':r -> reverse r@@ -262,8 +288,8 @@ 5 gets a major ticks (ie the major ticks need to be a subset of the minor tick) -}-logTicks :: Range -> ([Rational],[Rational])-logTicks (low,high) = (major,minor)+logTicks :: Range -> ([Rational],[Rational],[Rational])+logTicks (low,high) = (major,minor,major) where ratio = high/low lower a l = let (i,r) = frac (log10 a) in@@ -358,45 +384,24 @@ ---------------------------------------------------------------------- -refClockTime = toClockTime CalendarTime {- ctYear=2000,- ctMonth=toEnum 0,- ctDay=1,- ctHour=0,- ctMin=0,- ctSec=0,- ctPicosec=0,- ctTZ=0,- ctWDay=Saturday,- ctYDay=0,- ctTZName="",- ctIsDST=False- }---- | Map a clocktime value to a plot cordinate-doubleFromClockTime :: ClockTime -> Double-doubleFromClockTime ct = fromIntegral (tdSec (diffClockTimes ct refClockTime))+-- | Map a LocalTime value to a plot cordinate+doubleFromLocalTime :: LocalTime -> Double+doubleFromLocalTime lt = fromIntegral (toModifiedJulianDay (localDay lt)) + + fromRational (timeOfDayToDayFraction (localTimeOfDay lt)) --- | Map a plot cordinate to a clocktime-clockTimeFromDouble :: Double -> ClockTime-clockTimeFromDouble v = (addToClockTime tdiff refClockTime)- where- tdiff = TimeDiff {- tdYear = 0,- tdMonth = 0,- tdDay = 0,- tdHour = 0,- tdMin = 0,- tdSec = floor v,- tdPicosec = 0- }+-- | Map a plot cordinate to a LocalTime+localTimeFromDouble :: Double -> LocalTime+localTimeFromDouble v = + LocalTime (ModifiedJulianDay i) (dayFractionToTimeOfDay (toRational d))+ where+ (i,d) = properFraction v -- | TimeSeq is a (potentially infinite) set of times. When passes -- a reference time, the function returns a a pair of lists. The first -- contains all times in the set less than the reference time in -- decreasing order. The second contains all times in the set greater -- than or equal to the reference time, in increasing order.-type TimeSeq = ClockTime-> ([ClockTime],[ClockTime])+type TimeSeq = LocalTime-> ([LocalTime],[LocalTime]) coverTS tseq min max = min' ++ enumerateTS tseq min max ++ max' where@@ -412,16 +417,12 @@ _ -> False -- | How to display a time-type TimeLabelFn = ClockTime -> String---- | Use an strftime() formatted string to display a time-formatTime :: String -> TimeLabelFn-formatTime s t = formatCalendarTime defaultTimeLocale s (toUTCTime t)+type TimeLabelFn = LocalTime -> String -- | Create an 'AxisFn' to for a time axis. The first 'TimeSeq' sets the minor ticks, -- and the ultimate range will aligned to it's elements. The second 'TimeSeq' sets--- the labels and grid. The 'TimeLabelFn' is used to format clocktimes for labels.--- The values to be plotted against this axis can be created with 'doubleFromClockTime'+-- the labels and grid. The 'TimeLabelFn' is used to format LocalTimes for labels.+-- The values to be plotted against this axis can be created with 'doubleFromLocalTime' timeAxis :: TimeSeq -> TimeSeq -> TimeLabelFn -> Axis -> AxisFn timeAxis tseq lseq labelf a pts = Just axis where@@ -432,11 +433,11 @@ axis_grid=[ t | t <- ltimes', visible t] } (min,max) = case pts of- [] -> (refClockTime,refClockTime)+ [] -> (refLocalTime,refLocalTime) ps -> let min = minimum ps max = maximum ps in (ctfd min,ctfd max)-+ refLocalTime = LocalTime (ModifiedJulianDay 0) midnight times = coverTS tseq min max ltimes = coverTS lseq min max ltimes' = map dfct ltimes@@ -444,50 +445,52 @@ max' = maximum times visible t = dfct min' <= t && t <= dfct max' labels = [ ((dfct m2 + dfct m1) / 2, labelf m1) | (m1,m2) <- zip ltimes (tail ltimes) ]- dfct = doubleFromClockTime- ctfd = clockTimeFromDouble+ dfct = doubleFromLocalTime+ ctfd = localTimeFromDouble -- | A 'TimeSeq' for calendar days days :: TimeSeq-days t = (iterate rev t1, tail (iterate fwd t1))- where t0 = (toClockTime.zeroTime.toUTCTime) t- t1 = if t0 < t then t0 else (rev t0)- rev = addToClockTime noTimeDiff{tdDay=(-1)}- fwd = addToClockTime noTimeDiff{tdDay=1}+days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))+ where t0 = (localDay t)+ t1 = if (toTime t0) < t then t0 else (rev t0)+ rev = pred+ fwd = succ+ toTime d = LocalTime d midnight -- | A 'TimeSeq' for calendar months months :: TimeSeq-months t = (iterate rev t1, tail (iterate fwd t1))- where t0 = (toClockTime.(\t -> t{ctDay=1}).zeroTime.toUTCTime) t- t1 = if t0 < t then t0 else (rev t0)- rev = addToClockTime noTimeDiff{tdMonth=(-1)}- fwd = addToClockTime noTimeDiff{tdMonth=1}+months t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))+ where t0 = let (y,m,d) = toGregorian $ localDay t in fromGregorian y m 1+ t1 = if toTime t0 < t then t0 else (rev t0)+ rev = addGregorianMonthsClip (-1)+ fwd = addGregorianMonthsClip 1+ toTime d = LocalTime d midnight -- | A 'TimeSeq' for calendar years years :: TimeSeq-years t = (iterate rev t1, tail (iterate fwd t1))- where t0 = (toClockTime.(\t -> t{ctMonth=January,ctDay=1}).zeroTime.toUTCTime) t- t1 = if t0 < t then t0 else (rev t0)- rev = addToClockTime noTimeDiff{tdMonth=(-12)}- fwd = addToClockTime noTimeDiff{tdMonth=12}--zeroTime t = t{ctHour=0,ctMin=0,ctSec=0,ctPicosec=0}+years t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))+ where t0 = let (y,m,d) = toGregorian $ localDay t in y+ t1 = if toTime t0 < t then t0 else (rev t0)+ rev = pred+ fwd = succ+ toTime y = LocalTime (fromGregorian y 1 1) midnight -- | Automatically choose a suitable time axis, based upon the time range of data.--- The values to be plotted against this axis can be created with 'doubleFromClockTime'+-- The values to be plotted against this axis can be created with 'doubleFromLocalTime' autoTimeAxis :: Axis -> AxisFn autoTimeAxis a pts =- if tdiff < (normalizeTimeDiff noTimeDiff{tdDay=15})- then timeAxis days days (formatTime "%d-%b") a pts- else if tdiff < (normalizeTimeDiff noTimeDiff{tdMonth=3})- then timeAxis days months (formatTime "%b-%y") a pts- else if tdiff < (normalizeTimeDiff noTimeDiff{tdMonth=15})- then timeAxis months months (formatTime "%b-%y") a pts- else if tdiff < (normalizeTimeDiff noTimeDiff{tdMonth=60})- then timeAxis months years (formatTime "%Y") a pts- else timeAxis years years (formatTime "%Y") a pts+ if tdiff < 15+ then timeAxis days days (ft "%d-%b") a pts+ else if tdiff < 90+ then timeAxis days months (ft "%b-%y") a pts+ else if tdiff < 450+ then timeAxis months months (ft "%b-%y") a pts+ else if tdiff < 1800+ then timeAxis months years (ft "%Y") a pts+ else timeAxis years years (ft "%Y") a pts where- tdiff = normalizeTimeDiff (t1 `diffClockTimes` t0)- t1 = clockTimeFromDouble (maximum pts)- t0 = clockTimeFromDouble (minimum pts)+ tdiff = t1 - t0+ t1 = maximum pts+ t0 = minimum pts+ ft = formatTime defaultTimeLocale
Graphics/Rendering/Chart/Gtk.hs view
@@ -39,6 +39,4 @@ G.renderWithDrawable win $ runCRender (rfn rect) bitmapEnv return True where- rfn rect = do- alignPixels- render chart rect+ rfn rect = render chart rect
Graphics/Rendering/Chart/Layout.hs view
@@ -13,6 +13,7 @@ import Graphics.Rendering.Chart.Plot import Graphics.Rendering.Chart.Renderable import Control.Monad+import Control.Monad.Reader (local) -- | The side of an horizontal axis data HAxis = HA_Top | HA_Bottom deriving (Eq)@@ -30,7 +31,8 @@ layout1_vertical_axes :: AxesFn, layout1_margin :: Double, layout1_plots :: [(String,HAxis,VAxis,Plot)],- layout1_legend :: Maybe(LegendStyle)+ layout1_legend :: Maybe(LegendStyle),+ layout1_grid_last :: Bool } instance ToRenderable Layout1 where@@ -90,13 +92,11 @@ renderPlots l r@(Rect p1 p2) = preserveCState $ do -- render the plots setClipRegion p1 p2 - mapM_ (rPlot r) (layout1_plots l) - -- render the axes grids- maybeM () (renderAxisGrid r) tAxis- maybeM () (renderAxisGrid r) bAxis- maybeM () (renderAxisGrid r) lAxis- maybeM () (renderAxisGrid r) rAxis+ when (not (layout1_grid_last l)) renderGrids+ local (const vectorEnv) $ do+ mapM_ (rPlot r) (layout1_plots l)+ when (layout1_grid_last l) renderGrids where (bAxis,lAxis,tAxis,rAxis) = getAxes l@@ -117,6 +117,12 @@ in plot_render p pmfn rPlot1 _ _ _ _ = return () + renderGrids = do+ maybeM () (renderAxisGrid r) tAxis+ maybeM () (renderAxisGrid r) bAxis+ maybeM () (renderAxisGrid r) lAxis+ maybeM () (renderAxisGrid r) rAxis+ axesSpacer f1 a1 f2 a2 = embedRenderable $ do oh1 <- maybeM (0,0) axisOverhang a1 oh2 <- maybeM (0,0) axisOverhang a2@@ -148,11 +154,12 @@ defaultLayout1 = Layout1 { layout1_background = solidFillStyle white, layout1_title = "",- layout1_title_style = fontStyle "sans" 15 C.FontSlantNormal C.FontWeightBold,+ layout1_title_style = defaultFontStyle{font_size=15, font_weight=C.FontWeightBold}, layout1_horizontal_axes = linkedAxes (autoScaledAxis defaultAxis), layout1_vertical_axes = linkedAxes (autoScaledAxis defaultAxis), layout1_margin = 10, layout1_plots = [],- layout1_legend = Just defaultLegendStyle+ layout1_legend = Just defaultLegendStyle,+ layout1_grid_last = False }
+ Graphics/Rendering/Chart/Pie.hs view
@@ -0,0 +1,154 @@+module Graphics.Rendering.Chart.Pie where +-- original code thanks to Neal Alexander + +import qualified Graphics.Rendering.Cairo as C + +import Data.List +import Data.Bits +import Control.Monad + +import Graphics.Rendering.Chart.Types +import Graphics.Rendering.Chart.Renderable + +data PieLayout = PieLayout { + pie_title :: String, + pie_title_style :: CairoFontStyle, + pie_plot :: PieChart, + pie_background :: CairoFillStyle, + pie_margin :: Double +} + +data PieChart = PieChart { + pie_data :: [PieItem], + pie_colors :: [Color], + pie_label_style :: CairoFontStyle, + pie_label_line_style :: CairoLineStyle, + pie_start_angle :: Double + +} + +data PieItem = PieItem { + pitem_label :: String, + pitem_offset :: Double, + pitem_value :: Double +} + +defaultPieChart = PieChart { + pie_data = [], + pie_colors = defaultColorSeq, + pie_label_style = defaultFontStyle, + pie_label_line_style = solidLine 1 black, + pie_start_angle = 0 +} + +defaultPieItem = PieItem "" 0 0 + +defaultPieLayout = PieLayout { + pie_background = solidFillStyle white, + pie_title = "", + pie_title_style = defaultFontStyle{font_size=15, font_weight=C.FontWeightBold}, + pie_plot = defaultPieChart, + pie_margin = 10 +} + +instance ToRenderable PieLayout where + toRenderable p = fillBackground (pie_background p) ( + vertical [ + (0, addMargins (lm/2,0,0,0) title), + (1, addMargins (lm,lm,lm,lm) (toRenderable $ pie_plot p)) + ] ) + where + title = label (pie_title_style p) HTA_Centre VTA_Top (pie_title p) + lm = pie_margin p + +instance ToRenderable PieChart where + toRenderable p = Renderable { + minsize=minsizePie p, + render=renderPie p + } + +extraSpace p = do + textSizes <- mapM textSize (map pitem_label (pie_data p)) + let maxw = foldr (max.fst) 0 textSizes + let maxh = foldr (max.snd) 0 textSizes + let maxo = foldr (max.pitem_offset) 0 (pie_data p) + let extra = label_rgap + label_rlength + maxo + return (extra + maxw, extra + maxh ) + +minsizePie p = do + (extraw,extrah) <- extraSpace p + return (extraw * 2, extrah * 2) + +renderPie p (Rect p1 p2) = do + (extraw,extrah) <- extraSpace p + let (w,h) = (p_x p2 - p_x p1, p_y p2 - p_y p1) + let center = Point (p_x p1 + w/2) (p_y p1 + h/2) + let radius = (min (w - 2*extraw) (h - 2*extrah)) / 2 + + foldM_ (paint center radius) (pie_start_angle p) (zip (pie_colors p) content) + + where + content = let total = sum (map pitem_value (pie_data p)) + in [ pi{pitem_value=pitem_value pi/total} | pi <- pie_data p ] + + paint :: Point -> Double -> Double -> (Color,PieItem) -> CRender Double + paint center radius a1 (color,pitem) = do + let ax = 360.0 * (pitem_value pitem) + let a2 = a1 + (ax / 2) + let a3 = a1 + ax + let offset = pitem_offset pitem + + pieSlice (ray a2 offset) a1 a3 color + pieLabel (pitem_label pitem) a2 offset + + return a3 + + where + pieLabel :: String -> Double -> Double -> CRender () + pieLabel name angle offset = do + setFontStyle (pie_label_style p) + setLineStyle (pie_label_line_style p) + + moveTo (ray angle (radius + label_rgap+offset)) + let p1 = (ray angle (radius + label_rgap + label_rlength+offset)) + lineTo p1 + (tw,th) <- textSize name + let (offset,anchor) = if angle < 90 || angle > 270 + then ((0+),HTA_Left) + else ((0-),HTA_Right) + c $ C.relLineTo (offset (tw + label_rgap)) 0 + c $ C.stroke + + let p2 = p1 `pvadd` (Vector (offset label_rgap) 0) + drawText anchor VTA_Bottom p2 name + + pieSlice :: Point -> Double -> Double -> Color -> CRender () + pieSlice (Point x y) a1 a2 color = c $ do + C.newPath + C.arc x y radius (radian a1) (radian a2) + C.lineTo x y + C.lineTo x y + C.closePath + + setSourceColor color + C.fillPreserve + C.setSourceRGBA 1 1 1 0.1 + + C.stroke + + ray :: Double -> Double -> Point + ray angle r = Point x' y' + where + x' = x + (cos' * x'') + y' = y + (sin' * x'') + cos' = (cos . radian) angle + sin' = (sin . radian) angle + x'' = ((x + r) - x) + x = p_x center + y = p_y center + + radian = (*(pi / 180.0)) + + +label_rgap = 5 +label_rlength = 15
Graphics/Rendering/Chart/Plot.hs view
@@ -79,7 +79,10 @@ lineTo (Point (p_x p2) y) c $ C.stroke -defaultPlotLineStyle = solidLine 1 blue+defaultPlotLineStyle = (solidLine 1 blue){ + line_cap = C.LineCapRound,+ line_join = C.LineJoinRound+ } defaultPlotLines = PlotLines { plot_lines_style = defaultPlotLineStyle,
Graphics/Rendering/Chart/Renderable.hs view
@@ -110,51 +110,43 @@ C.surfaceWriteToPNG result path where rfn = do- alignPixels render chart rect rect = Rect (Point 0 0) (Point (fromIntegral width) (fromIntegral height)) --- | Output the given renderable to a PDF file of the specifed size--- (in points), to the specified file.-renderableToPDFFile :: Renderable -> Int -> Int -> FilePath -> IO ()-renderableToPDFFile chart width height path = - C.withPDFSurface path (fromIntegral width) (fromIntegral height) $ \result -> do+renderableToFile withSurface chart width height path = + withSurface path (fromIntegral width) (fromIntegral height) $ \result -> do C.renderWith result $ runCRender rfn vectorEnv C.surfaceFinish result where rfn = do- render chart rect+ render chart rect c $ C.showPage rect = Rect (Point 0 0) (Point (fromIntegral width) (fromIntegral height)) +-- | Output the given renderable to a PDF file of the specifed size+-- (in points), to the specified file.+renderableToPDFFile :: Renderable -> Int -> Int -> FilePath -> IO ()+renderableToPDFFile = renderableToFile C.withPDFSurface+ -- | Output the given renderable to a postscript file of the specifed size -- (in points), to the specified file. renderableToPSFile :: Renderable -> Int -> Int -> FilePath -> IO ()-renderableToPSFile chart width height path = - C.withPSSurface path (fromIntegral width) (fromIntegral height) $ \result -> do- C.renderWith result $ runCRender rfn vectorEnv- C.surfaceFinish result- where- rfn = do- render chart rect- c $ C.showPage+renderableToPSFile = renderableToFile C.withPSSurface - rect = Rect (Point 0 0) (Point (fromIntegral width) (fromIntegral height))+-- | Output the given renderable to an SVG file of the specifed size+-- (in points), to the specified file.+renderableToSVGFile :: Renderable -> Int -> Int -> FilePath -> IO ()+renderableToSVGFile = renderableToFile C.withSVGSurface bitmapEnv = CEnv adjfn where- adjfn (Point x y)= Point (fromIntegral (round x)) (fromIntegral (round y))+ adjfn (Point x y)= Point (adj x) (adj y)+ adj x = (fromIntegral (round (x-0.5)))+0.5 vectorEnv = CEnv id -alignPixels :: CRender ()-alignPixels = do- -- move to centre of pixels so that stroke width of 1 is- -- exactly one pixel - c $ C.translate 0.5 0.5- embedRenderable :: CRender Renderable -> Renderable embedRenderable ca = Renderable { minsize = do { a <- ca; minsize a },@@ -182,6 +174,7 @@ minsizeLegend :: Legend -> CRender RectSize minsizeLegend (Legend _ ls plots) = do let labels = nub $ map fst plots+ setFontStyle $ legend_label_style ls lsizes <- mapM textSize labels lgap <- legendSpacer let lm = legend_margin ls@@ -200,6 +193,7 @@ rf :: Point -> (String,[Plot]) -> CRender Point rf p1 (label,theseplots) = do+ setFontStyle $ legend_label_style ls (w,h) <- textSize label lgap <- legendSpacer let p2 = (p1 `pvadd` Vector lps 0)@@ -265,7 +259,7 @@ vs = [VTA_Top, VTA_Centre, VTA_Bottom] fwhite = solidFillStyle white fblue = solidFillStyle (Color 0.8 0.8 1)- fs = fontStyle "sans" 30 C.FontSlantNormal C.FontWeightBold+ fs = defaultFontStyle{font_size=30,font_weight=C.FontWeightBold} crossHairs r =Renderable { minsize = minsize r, render = \rect@(Rect (Point x1 y1) (Point x2 y2)) -> do
Graphics/Rendering/Chart/Simple.hs view
@@ -22,13 +22,13 @@ -- -- Examples: ----- renderableToWindow (toRenderable $ plot [0,0.1..10] sin "sin(x)") 640 480+-- @renderableToWindow (toRenderable $ plot [0,0.1..10] sin "sin(x)") 640 480@ ----- plotWindow [0,1,3,4,8]] [12,15,1,5,8] "o" "points"+-- @plotWindow [0,1,3,4,8]] [12,15,1,5,8] "o" "points"@ ----- plotPDF "foo.pdf" [0,0.1..10] sin "- " cos ". " cos "o"+-- @plotPDF "foo.pdf" [0,0.1..10] sin "- " cos ". " cos "o"@ ----- plotPS "foo.ps" [0,0.1..10] (sin.exp) "- " (sin.exp) "o-"+-- @plotPS "foo.ps" [0,0.1..10] (sin.exp) "- " (sin.exp) "o-"@ ----------------------------------------------------------------------------- module Graphics.Rendering.Chart.Simple( plot, PlotKind(..), xcoords, plotWindow, plotPDF, plotPS@@ -221,6 +221,20 @@ instance PlotPSType (IO a) where pls fn args = do renderableToPSFile (toRenderable $ uplot (reverse args)) 640 480 fn return undefined++-- | Save a plot as a png file+plotPNG :: PlotPNGType a => String -> a+plotPNG fn = plp fn []++class PlotPNGType t where+ plp :: FilePath -> [UPlot] -> t+instance (PlotArg a, PlotPNGType r) => PlotPNGType (a -> r) where+ plp fn args = \ a -> plp fn (toUPlot a ++ args)+instance PlotPNGType (IO a) where+ plp fn args = do renderableToPNGFile (toRenderable $ uplot (reverse args)) 640 480 fn+ return undefined++ data UPlot = UString String | UDoubles [Double] | UFunction (Double -> Double) | UKind [PlotKind] | X [Double]
Graphics/Rendering/Chart/Types.hs view
@@ -91,23 +91,29 @@ -- style, at the supplied device coordinates. newtype CairoPointStyle = CairoPointStyle (Point -> CRender ()) --- | Abstract data type for the style of a line------ The contained Cairo action sets the required line--- in the Cairo rendering state.-newtype CairoLineStyle = CairoLineStyle (CRender ())-+-- | Data type for the style of a line+data CairoLineStyle = CairoLineStyle {+ line_width :: Double,+ line_color :: Color,+ line_dashes :: [Double],+ line_cap :: C.LineCap,+ line_join :: C.LineJoin+}+ -- | Abstract data type for a fill style -- -- The contained Cairo action sets the required fill -- style in the Cairo rendering state. newtype CairoFillStyle = CairoFillStyle (CRender ()) --- | Abstract data type for a font.------ The contained Cairo action sets the required font--- in the Cairo rendering state.-newtype CairoFontStyle = CairoFontStyle (CRender ())+-- | Data type for a font+data CairoFontStyle = CairoFontStyle {+ font_name :: String,+ font_size :: Double,+ font_slant :: C.FontSlant,+ font_weight :: C.FontWeight,+ font_color :: Color+} type Range = (Double,Double) type RectSize = (Double,Double)@@ -119,6 +125,7 @@ green = Color 0 1 0 blue = Color 0 0 1 +defaultColorSeq = cycle [blue,red,green, Color 1 1 0,Color 0 1 1,Color 1 0 1 ] ---------------------------------------------------------------------- -- Assorted helper functions in Cairo Usage @@ -163,8 +170,20 @@ C.lineTo x1 y2 C.lineTo x1 y1 -setFontStyle (CairoFontStyle s) = s-setLineStyle (CairoLineStyle s) = s+setFontStyle f = do+ c $ C.selectFontFace (font_name f) (font_slant f) (font_weight f)+ c $ C.setFontSize (font_size f)+ c $ setSourceColor (font_color f)++setLineStyle ls = do+ c $ C.setLineWidth (line_width ls)+ c $ setSourceColor (line_color ls)+ c $ C.setLineCap (line_cap ls)+ c $ C.setLineJoin (line_join ls)+ case line_dashes ls of+ [] -> return ()+ ds -> c $ C.setDash ds 0+ setFillStyle (CairoFillStyle s) = s setSourceColor (Color r g b) = C.setSourceRGB r g b@@ -336,33 +355,14 @@ Double -- ^ width of line -> Color -> CairoLineStyle-solidLine w cl = CairoLineStyle (do- c $ C.setLineWidth w- c $ setSourceColor cl- )+solidLine w cl = CairoLineStyle w cl [] C.LineCapButt C.LineJoinMiter dashedLine :: Double -- ^ width of line -> [Double] -- ^ the dash pattern in device coordinates -> Color -> CairoLineStyle-dashedLine w dashes cl = CairoLineStyle (do- c $ C.setDash dashes 0- c $ C.setLineWidth w- c $ setSourceColor cl- )--fontStyle ::- String -- ^ the font name- -> Double -- ^ the font size- -> C.FontSlant -- ^ the font slant- -> C.FontWeight -- ^ the font weight- -> CairoFontStyle-fontStyle name size slant weight = CairoFontStyle fn- where- fn = do- c $ C.selectFontFace name slant weight- c $ C.setFontSize size+dashedLine w ds cl = CairoLineStyle w cl ds C.LineCapButt C.LineJoinMiter solidFillStyle :: Color@@ -371,6 +371,13 @@ where fn = c $ setSourceColor cl defaultPointStyle = filledCircles 1 white-defaultFontStyle = CairoFontStyle (return ())++defaultFontStyle = CairoFontStyle {+ font_name = "sans",+ font_size = 10,+ font_slant = C.FontSlantNormal,+ font_weight = C.FontWeightNormal,+ font_color = black+} isValidNumber v = not (isNaN v) && not (isInfinite v)
tests/test.hs view
@@ -5,14 +5,17 @@ import System.Environment(getArgs) import System.Time import System.Random+import Data.Time.Calendar+import Data.Time.LocalTime import Prices -data OutputType = Window | PNG | PS | PDF+data OutputType = Window | PNG | PS | PDF | SVG chooseLineWidth Window = 1.0 chooseLineWidth PNG = 1.0 chooseLineWidth PDF = 0.25 chooseLineWidth PS = 0.25+chooseLineWidth SVG = 0.25 blue = (Color 0 0 1) green = (Color 0 1 0)@@ -21,8 +24,8 @@ red1 = (Color 0.5 0.5 1) -----------------------------------------------------------------------test1 :: OutputType -> IO Layout1-test1 otype = return layout +test1 :: OutputType -> IO Renderable+test1 otype = return (toRenderable layout) where am :: Double -> Double am x = (sin (x*3.14159/45) + 1) / 2 * (sin (x*3.14159/5))@@ -47,54 +50,86 @@ lineWidth = chooseLineWidth otype ++test1a :: OutputType -> IO Renderable+test1a otype = return (toRenderable layout)+ where+ am :: Double -> Double+ am x = (sin (x*3.14159/45) + 1) / 2 * (sin (x*3.14159/5))++ sinusoid1 = defaultPlotLines {+ plot_lines_values = [[ (Point x (am x)) | x <- [0,(0.5)..400]]],+ plot_lines_style = solidLine lineWidth blue+ }++ sinusoid2 = defaultPlotPoints {+ plot_points_style=filledCircles 2 red,+ plot_points_values = [ (Point x (am x)) | x <- [0,7..400]]+ }++ lap = defaultLinearAxis{la_nLabels=2,la_nTicks=20,la_gridAtMinor=True}++ layout = defaultLayout1 {+ layout1_title="Amplitude Modulation", + layout1_horizontal_axes=linkedAxes (autoScaledAxis' lap defaultAxis),+ layout1_vertical_axes=linkedAxes (autoScaledAxis' lap defaultAxis),+ layout1_plots = [("am",HA_Bottom,VA_Left,(toPlot sinusoid1)),+ ("am points", HA_Bottom,VA_Left,(toPlot sinusoid2))]+ }++ lineWidth = chooseLineWidth otype+ -----------------------------------------------------------------------test2 :: OutputType -> [(Int,Int,Int,Double,Double)] -> IO Layout1-test2 otype prices = return layout +test2 :: [(Int,Int,Int,Double,Double)] -> OutputType -> IO Renderable+test2 prices otype = return (toRenderable layout) where + lineStyle c = (plot_lines_style defaultPlotLines){+ line_width=3 * chooseLineWidth otype,+ line_color = c+ }+ price1 = defaultPlotLines {- plot_lines_style = solidLine lineWidth blue,+ plot_lines_style = lineStyle blue, plot_lines_values = [[ Point (date d m y) v | (d,m,y,v,_) <- prices]] } price2 = defaultPlotLines {- plot_lines_style = solidLine lineWidth green,+ plot_lines_style = lineStyle green, plot_lines_values = [[ Point (date d m y) v | (d,m,y,_,v) <- prices]] } - gridlessAxis = defaultAxis{axis_grid=[]}- vaxis = autoScaledAxis gridlessAxis+ baseAxis = defaultAxis{+ axis_grid=[],+ axis_line_style=solidLine 1 fg,+ axis_grid_style=solidLine 1 fg1,+ axis_label_style=(axis_label_style defaultAxis){font_color=fg}+ } + vaxis = autoScaledAxis baseAxis+ bg = Color 0 0 0.25+ fg = Color 1 1 1+ fg1 = Color 0.0 0.0 0.15+ layout = defaultLayout1 {- layout1_title="Price History", - layout1_horizontal_axes=linkedAxes' (autoTimeAxis gridlessAxis),+ layout1_title="Price History",+ layout1_title_style=(layout1_title_style defaultLayout1){font_color=fg},+ layout1_background=solidFillStyle bg,+ layout1_horizontal_axes=linkedAxes' (autoTimeAxis baseAxis), layout1_vertical_axes=independentAxes vaxis vaxis, layout1_plots = [("price 1", HA_Bottom,VA_Left,(toPlot price1)),- ("price 2", HA_Bottom,VA_Right,(toPlot price2))]+ ("price 2", HA_Bottom,VA_Right,(toPlot price2))],+ layout1_legend = Just (defaultLegendStyle{+ legend_label_style=(legend_label_style defaultLegendStyle){font_color=fg}+ } ),+ layout1_grid_last=False } - lineWidth = chooseLineWidth otype--date dd mm yyyy = doubleFromClockTime ct- where- ct = toClockTime CalendarTime {- ctYear=yyyy,- ctMonth=toEnum (mm-1),- ctDay=dd,- ctHour=0,- ctMin=0,- ctSec=0,- ctPicosec=0,- ctTZ=0,- ctWDay=Monday,- ctYDay=0,- ctTZName="",- ctIsDST=False- }+date dd mm yyyy = doubleFromLocalTime (LocalTime (fromGregorian (fromIntegral yyyy) mm dd) midnight) -----------------------------------------------------------------------test3 :: OutputType -> IO Layout1-test3 otype = return layout +test3 :: OutputType -> IO Renderable+test3 otype = return (toRenderable layout) where price1 = defaultPlotFillBetween {@@ -116,8 +151,8 @@ } ---------------------------------------------------------------------- -test4 :: OutputType -> IO Layout1-test4 otype = return layout +test4 :: OutputType -> IO Renderable+test4 otype = return (toRenderable layout) where points = defaultPlotPoints {@@ -141,10 +176,10 @@ ---------------------------------------------------------------------- -- Example thanks to Russell O'Connor -test5 :: OutputType -> IO Layout1+test5 :: OutputType -> IO Renderable test5 otype = do bits <- fmap randoms getStdGen- return (layout 1001 (trial bits))+ return (toRenderable (layout 1001 (trial bits))) where layout n t = defaultLayout1 { layout1_title="Simulation of betting on a biased coin", @@ -178,8 +213,8 @@ ---------------------------------------------------------------------- -- Test the Simple interface -test6 :: OutputType -> IO Layout1-test6 otype = return pp{layout1_title="Graphics.Rendering.Chart.Simple example"}+test6 :: OutputType -> IO Renderable+test6 otype = return (toRenderable pp{layout1_title="Graphics.Rendering.Chart.Simple example"}) where pp = plot xs sin "sin" cos "cos" "o"@@ -188,9 +223,10 @@ (const 0.5) [0.1,0.7,0.5::Double] "+" xs = [0,0.3..3] :: [Double]+ -----------------------------------------------------------------------test7 :: OutputType -> IO Layout1-test7 otype = return layout +test7 :: OutputType -> IO Renderable+test7 otype = return (toRenderable layout) where vals = [ (x,sin (exp x),sin x/2,cos x/10) | x <- [1..20]] bars = defaultPlotErrBars {@@ -207,18 +243,36 @@ ("test",HA_Bottom,VA_Left,(toPlot points))] } +----------------------------------------------------------------------+test8 :: OutputType -> IO Renderable+test8 otype = return (toRenderable layout)+ where+ values = [ ("eggs",38,e), ("milk",45,e), ("bread",11,e1), ("salmon",8,e) ]+ e = 0+ e1 = 25+ layout = defaultPieLayout {+ pie_title = "Pie Chart Example",+ pie_plot = defaultPieChart {+ pie_data = [ defaultPieItem{pitem_value=v,pitem_label=s,pitem_offset=o} + | (s,v,o) <- values ]+ }+ }+ ---------------------------------------------------------------------- +allTests :: [ (String, OutputType -> IO Renderable) ] allTests =- [ ("test1",test1)- , ("test2a",\ot -> test2 ot prices)- , ("test2b",\ot -> test2 ot (filterPrices (date 1 1 2005) (date 31 12 2005)))- , ("test2c",\ot -> test2 ot (filterPrices (date 1 5 2005) (date 1 7 2005)))- , ("test2d",\ot -> test2 ot (filterPrices (date 1 1 2006) (date 10 1 2006)))- , ("test3",test3)- , ("test4",test4)- , ("test5",test5)- , ("test6",test6)- , ("test7",test7)+ [ ("test1", test1)+ , ("test1a", test1a)+ , ("test2a", test2 prices)+ , ("test2b", test2 (filterPrices (date 1 1 2005) (date 31 12 2005)))+ , ("test2c", test2 (filterPrices (date 1 5 2005) (date 1 7 2005)))+ , ("test2d", test2 (filterPrices (date 1 1 2006) (date 10 1 2006)))+ , ("test3", test3)+ , ("test4", test4)+ , ("test5", test5)+ , ("test6", test6)+ , ("test7", test7)+ , ("test8", test8) ] filterPrices t1 t2 = [ v | v@(d,m,y,_,_) <- prices, let t = date d m y in t >= t1 && t <= t2]@@ -227,17 +281,22 @@ args <- getArgs main1 args +main1 :: [String] -> IO () main1 ("--png":tests) = showTests tests renderToPNG main1 ("--pdf":tests) = showTests tests renderToPDF+main1 ("--svg":tests) = showTests tests renderToSVG main1 ("--ps":tests) = showTests tests renderToPS main1 tests = showTests tests renderToWindow -showTests tests outputfn = mapM_ outputfn (filter (match tests) allTests)+showTests :: [String] -> ((String,OutputType -> IO Renderable) -> IO()) -> IO ()+showTests tests ofn = mapM_ ofn (filter (match tests) allTests) +match :: [String] -> (String,a) -> Bool match [] t = True match ts t = (fst t) `elem` ts -renderToWindow (n,t) = t Window >>= \l -> renderableToWindow (toRenderable l) 640 480-renderToPNG (n,t) = t PNG >>= \l -> renderableToPNGFile (toRenderable l) 640 480 (n ++ ".png")-renderToPS (n,t) = t PS >>= \l -> renderableToPSFile (toRenderable l) 640 480 (n ++ ".ps")-renderToPDF (n,t) = t PDF >>= \l -> renderableToPDFFile (toRenderable l) 640 480 (n ++ ".pdf")+renderToWindow (n,ir) = do { r <- ir Window; renderableToWindow r 640 480}+renderToPNG (n,ir) = do { r <- ir PNG; renderableToPNGFile r 640 480 (n ++ ".png")}+renderToPS (n,ir) = do { r <- ir PS; renderableToPSFile r 640 480 (n ++ ".ps")}+renderToPDF (n,ir) = do { r <- ir PDF; renderableToPDFFile r 640 480 (n ++ ".pdf")}+renderToSVG (n,ir) = do { r <- ir SVG; renderableToSVGFile r 640 480 (n ++ ".svg")}