packages feed

Chart (empty) → 0.5

raw patch · 12 files changed

+1840/−0 lines, 12 filesdep +basedep +cairodep +gtkbuild-type:Customsetup-changed

Dependencies added: base, cairo, gtk, old-locale, old-time

Files

+ Chart.cabal view
@@ -0,0 +1,34 @@+Name: Chart+Version: 0.5+License: BSD4+License-file: LICENSE+Copyright: Tim Docker, 2006+Author: Tim Docker <tim@dockerz.net>+Maintainer: Tim Docker <tim@dockerz.net>+Homepage: http://www.dockerz.net/software/chart.html+Synopsis: A library for generating 2D Charts and Plots+Description: A library for generating 2D Charts and Plots, based upon the cairo graphics library.+Category: Graphics+Cabal-Version: >= 1.2++Extra-Source-Files: tests/test.hs, tests/Prices.hs++flag splitbase+  description: Choose the new smaller, split-up base package.++library+  if flag(splitbase)+    Build-depends: base >= 3, old-locale, old-time+  else+    Build-depends: base < 3+  Build-depends: gtk >= 0.9.11, cairo >= 0.9.11++  Exposed-modules:+        Graphics.Rendering.Chart,+        Graphics.Rendering.Chart.Gtk,+        Graphics.Rendering.Chart.Types,+        Graphics.Rendering.Chart.Renderable,+        Graphics.Rendering.Chart.Axis,+        Graphics.Rendering.Chart.Layout,+        Graphics.Rendering.Chart.Plot+
+ Graphics/Rendering/Chart.hs view
@@ -0,0 +1,66 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- A Simple framework for creating 2D charts in Haskell.+--+-- The basic model is that you define a value of type 'Renderable',+-- typically by applying 'toRenderable' to some other value. This+-- 'Renderable' is then actually displayed or output by calling either+-- 'renderableToPNGFile', or 'Graphics.Rendering.Chart.Gtk.renderableToWindow'.+--+-- Currently, the only useful 'Renderable' for displaying charts+-- is created by applying 'toRenderable' to a value of type+-- 'Graphics.Rendering.Chart.Layout.Layout1'+-----------------------------------------------------------------------------++module Graphics.Rendering.Chart(+    Renderable(..),+    ToRenderable(..),+    Layout1(..),+    Axis(..),+    Plot(..),+    ToPlot(..),+    PlotPoints(..),+    PlotLines(..),+    PlotFillBetween(..),+    HAxis(..),+    VAxis(..),+    Rect(..),+    Point(..),+    defaultAxisLineStyle, +    defaultPlotLineStyle,+    defaultAxis, +    defaultPlotPoints,+    defaultPlotLines,+    defaultPlotFillBetween,+    defaultLayout1,+    filledCircles,+    solidLine,+    dashedLine,+    solidFillStyle,+    fontStyle,+    independentAxes,+    linkedAxes,+    linkedAxes',+    explicitAxis,+    autoScaledAxis,+    autoScaledLogAxis,+    monthsAxis,+    renderableToPNGFile,+    renderableToPDFFile,+    renderableToPSFile,+    doubleFromClockTime,+    clockTimeFromDouble,+    CairoLineStyle(..),+    CairoFillStyle(..),+    CairoFontStyle(..)+) where++import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable+import Graphics.Rendering.Chart.Layout+import Graphics.Rendering.Chart.Axis+import Graphics.Rendering.Chart.Plot
+ Graphics/Rendering/Chart/Axis.hs view
@@ -0,0 +1,430 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Axis+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)++module Graphics.Rendering.Chart.Axis where++import qualified Graphics.Rendering.Cairo as C+import System.Time+import System.Locale+import Control.Monad+import Data.List++import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Renderable++-- | The concrete data type for an axis+data Axis =  Axis {+		   +    -- | The axis_viewport function maps values into device+    -- cordinates.+    axis_viewport :: Range -> Double -> Double,++    -- | The tick marks on the axis as pairs.+    -- The first element is the position on the axis+    -- (in viewport units) and the second element is the+    -- length of the tick in output coordinates.+    -- The tick starts on the axis, and positive number are drawn+    -- towards the plot area.+    axis_ticks :: [(Double,Double)],+    +    -- | The labels on an axis as pairs. The first element +    -- is the position on the axis (in viewport units) and+    -- the second is the label text string.+    axis_labels :: [ (Double, String) ],++    -- | The positions on the axis (in viewport units) where+    -- we want to show grid lines.+    axis_grid :: [ Double ],++    -- | How far the labels are to be drawn from the axis.+    axis_label_gap :: Double,++    axis_line_style :: CairoLineStyle,+    axis_label_style :: CairoFontStyle,+    axis_grid_style :: CairoLineStyle++}++-- | Function type to generate an optional axis given a set+-- of points to be plotted against that axis.+type AxisFn = [Double] -> Maybe Axis++-- | Function type to generate a pair of axes (either top +-- and bottom, or left and right), given the set of points to+-- be plotted against each of them.+type AxesFn = [Double] -> [Double] -> (Maybe Axis,Maybe Axis)++data AxisT = AxisT RectEdge Axis++instance ToRenderable AxisT where+  toRenderable at = Renderable {+     minsize=minsizeAxis at,+     render=renderAxis at+  }++minsizeAxis :: AxisT -> C.Render RectSize+minsizeAxis (AxisT at a) = do+    let labels = map snd (axis_labels a)+    C.save+    setFontStyle (axis_label_style a)+    labelSizes <- mapM textSize labels+    C.restore+    let (lw,lh) = foldl maxsz (0,0) labelSizes+    let ag = axis_label_gap a+    let tsize = maximum [ max 0 (-l) | (v,l) <- axis_ticks a ]+    let sz = case at of+		     E_Top    -> (lw,max (lh + ag) tsize)+		     E_Bottom -> (lw,max (lh + ag) tsize)+		     E_Left   -> (max (lw + ag) tsize, lh)+		     E_Right  -> (max (lw + ag) tsize, lh)+    return sz++  where+    maxsz (w1,h1) (w2,h2) = (max w1 w2, max h1 h2)+++-- | Calculate the amount by which the labels extend beyond+-- the ends of the axis+axisOverhang :: AxisT -> C.Render (Double,Double)+axisOverhang (AxisT at a) = do+    let labels = map snd (sort (axis_labels a))+    C.save+    setFontStyle (axis_label_style a)+    labelSizes <- mapM textSize labels+    C.restore+    case labelSizes of+        [] -> return (0,0)+	ls  -> let l1 = head ls+		   l2 = last ls+		   ohangv = return (snd l1 / 2, snd l2 / 2)+		   ohangh = return (fst l1 / 2, fst l2 / 2)+		   in+		   case at of+		       E_Top -> ohangh+		       E_Bottom -> ohangh+		       E_Left -> ohangv+		       E_Right -> ohangh++renderAxis :: AxisT -> Rect -> C.Render ()+renderAxis at@(AxisT et a) rect = do+   C.save+   setLineStyle (axis_line_style a)+   strokeLines' True [Point sx sy,Point ex ey]+   mapM_ drawTick (axis_ticks a)+   C.restore+   C.save+   setFontStyle (axis_label_style a)+   mapM_ drawLabel (axis_labels a)+   C.restore+ where+   (sx,sy,ex,ey,tp,axisPoint) = axisMapping at rect++   drawTick (value,length) = +       let t1 = axisPoint value+	   t2 = t1 `pvadd` (vscale length tp)+       in strokeLines' True [t1,t2]++   (hta,vta,lp) = +       let g = axis_label_gap a+       in case et of+		  E_Top    -> (HTA_Centre,VTA_Bottom,(Vector 0 (-g)))+		  E_Bottom -> (HTA_Centre,VTA_Top,(Vector 0 g))+		  E_Left   -> (HTA_Right,VTA_Centre,(Vector (-g) 0))+		  E_Right  -> (HTA_Left,VTA_Centre,(Vector g 0))++   drawLabel (value,s) = do+       drawText hta vta (axisPoint value `pvadd` lp) s++axisMapping :: AxisT -> Rect -> (Double,Double,Double,Double,Vector,Double->Point)+axisMapping (AxisT et a) rect = case et of+    E_Top    -> (x1,y2,x2,y2, (Vector 0 1),    mapx (x1,x2) y2) +    E_Bottom -> (x1,y1,x2,y1, (Vector 0 (-1)), mapx (x1,x2) y1)+    E_Left   -> (x2,y2,x2,y1, (Vector (1) 0),  mapy (y1,y2) x2)		+    E_Right  -> (x1,y2,x1,y1, (Vector (-1) 0), mapy (y1,y2) x1)+  where+    (Rect (Point x1 y1) (Point x2 y2)) = rect++    mapx :: Range -> Double -> Double -> Point+    mapx xr y x = Point (axis_viewport a xr x) y++    mapy :: Range -> Double -> Double -> Point+    mapy (yr0,yr1) x y = Point x (axis_viewport a (yr1,yr0) y)++renderAxisGrid :: AxisT -> Rect -> C.Render ()+renderAxisGrid at@(AxisT re a) rect@(Rect p1 p2) = do+    C.save+    setLineStyle (axis_grid_style a)+    mapM_ (drawGridLine re) (axis_grid a)+    C.restore+  where+    (sx,sy,ex,ey,tp,axisPoint) = axisMapping at rect++    drawGridLine E_Top = vline+    drawGridLine E_Bottom = vline+    drawGridLine E_Left = hline+    drawGridLine E_Right = hline++    vline v = let v' = p_x (axisPoint v)+	      in strokeLines' True [Point v' (p_y p1),Point v' (p_y p2)]++    hline v = let v' = p_y (axisPoint v)+	      in strokeLines' True [Point (p_x p1) v',Point (p_x p2) v']++-- | Same as strokeLines, but with a flag that, when true will+-- adjust each point to land on a whole number. This is useful for+-- drawing known horizontal and vertical lines so that the occupy+-- exactly ++strokeLines' :: Bool -> [Point] -> C.Render ()+strokeLines' False ps = strokeLines ps+strokeLines' True  ps = strokeLines (map adjfn ps)+  where+    adjfn (Point x y)= Point (fromIntegral (round x)) (fromIntegral (round y))++----------------------------------------------------------------------++steps:: Double -> Range -> [Rational]+steps nSteps (min,max) = [ (fromIntegral (min' + i)) * s | i <- [0..n] ]+  where+    min' = floor (min / fromRational s)+    max' = ceiling (max / fromRational s)+    n = (max' - min')+    s = chooseStep nSteps (min,max)++chooseStep :: Double -> Range -> Rational+chooseStep nsteps (min,max) = s+  where+    mult = 10 ^^ (floor ((log (max-min) - log nsteps) / log 10))+    steps = map (mult*) [0.1, 0.2, 0.25, 0.5, 1.0, 2.0, 2.5, 5.0, 10, 20, 25, 50]+    steps' =  sort [ (abs((max-min)/(fromRational s) - nsteps), s) | s <- steps ]+    s = snd (head steps')++-- | Explicitly specify an axis+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 transform (rlabelvs, rtickvs) a = Just axis+  where+    axis =  a {+        axis_viewport=newViewport,+	axis_ticks=newTicks,+	axis_grid=gridvs,+	axis_labels=newLabels+	}+    newViewport = transform (min',max')+    newTicks = [ (v,2) | v <- tickvs ] ++ [ (v,5) | v <- labelvs ] +    newLabels = [(v,show v) | v <- labelvs]+    labelvs = map fromRational rlabelvs+    tickvs = map fromRational rtickvs+    min' = minimum labelvs+    max' = maximum labelvs++    gridvs = case (axis_grid a) of +       [] -> []+       _  -> labelvs++-- | 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 :: Axis -> AxisFn+autoScaledAxis a ps0 = autoAxis vmap (linearTicks (range ps)) 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)++log10 :: (Floating a) => a -> a+log10 = logBase 10++frac x | 0 <= b = (a,b)+       | otherwise = (a-1,b+1)+ where+  (a,b) = properFraction x++lmap (x1,x2) r x = vmap (log x1, log x2) r (log x)++{- + Rules: Do no subdivide between powers of 10 until all powers of 10+          get a major ticks.+        Do not subdivide between powers of ten as [1,2,4,6,8,10] when+          5 gets a major ticks +          (ie the major ticks need to be a subset of the minor tick)+-}+logTicks :: Range -> ([Rational],[Rational])+logTicks (low,high) = (major,minor)+ where+  ratio = high/low+  lower a l = let (i,r) = frac (log10 a) in+            (maximum (1:(filter (\x -> log10 (fromRational x) <= r) l)))*10^^i+  upper a l = let (i,r) = properFraction (log10 a) in+            (minimum (10:(filter (\x -> r <= log10 (fromRational x)) l)))*10^^i+  inRange (a,b) l x = (lower a l <= x) && (x <= upper b l)+  powers :: (Double,Double) -> [Rational] -> [Rational]+  powers (x,y) l = [a*10^^p | p<-[(floor (log10 x))..(ceiling (log10 y))], a<-l]+  midselection r l = filter (inRange r l) (powers r l)+  major | 17.5 < log10 ratio = map (\x -> 10^^(round x)) $+                         steps (min 5 (log10 ratio)) (log10 low, log10 high)+        | 12 < log10 ratio = map (\x -> 10^^(round x)) $+                         steps ((log10 ratio)/5) (log10 low, log10 high)+        | 6 < log10 ratio = map (\x -> 10^^(round x)) $+                         steps ((log10 ratio)/2) (log10 low, log10 high)+        | 3 < log10 ratio = midselection (low,high) [1,10]+        | 20 < ratio = midselection (low,high) [1,5,10]+        | 6 < ratio = midselection (low,high) [1,2,4,6,8,10]+        | 3 < ratio = midselection (low,high) [1..10]+        | otherwise = steps 5 (low,high)+  (l',h') = (minimum major, maximum major)+  (dl',dh') = (fromRational l', fromRational h')+  ratio' = fromRational (h'/l')+  minor | 50 < log10 ratio' = map (\x -> 10^^(round x)) $+                              steps 50 (log10 $ dl', log10 $ dh')+        | 6 < log10 ratio' = filter (\x -> l'<=x && x <=h') $+                             powers (dl', dh') [1,10]+        | 3 < log10 ratio' = filter (\x -> l'<=x && x <=h') $+                             powers (dl',dh') [1,5,10]+        | 6 < ratio' = filter (\x -> l'<=x && x <=h') $ +                       powers (dl',dh') [1..10]+        | 3 < ratio' = filter (\x -> l'<=x && x <=h') $ +                       powers (dl',dh') [1,1.2..10]+        | otherwise = steps 50 (dl', dh')++-- | Generate a log axis automatically.+-- The supplied axis is used as a template, with the viewport, ticks, labels+-- and grid set appropriately for the data displayed against that axies.+-- The resulting axis will only show a grid if the template has some grid+-- values.+autoScaledLogAxis :: Axis -> AxisFn+autoScaledLogAxis a ps0 = autoAxis lmap (logTicks (range ps)) a+  where+    ps = filter isValidNumber ps0+    (min, max) = (minimum ps,maximum ps)+    range [] = (3,30)+    range _  | min == max = (min/3,max*3)+	     | otherwise = (min,max)++-- | Show independent axes on each side of the layout+independentAxes :: AxisFn -> AxisFn -> AxesFn+independentAxes af1 af2 pts1 pts2 = (af1 pts1, af2 pts2)++-- | Show the same axis on both sides of the layout+linkedAxes :: AxisFn -> AxesFn+linkedAxes af pts1 pts2 = (a,a)+  where+    a = af (pts1++pts2)++-- | Show the same axis on both sides of the layout, but with labels+-- only on the primary side+linkedAxes' :: AxisFn -> AxesFn+linkedAxes' af pts1 pts2 = (a,removeLabels a)+  where+    a  = af (pts1++pts2)+    removeLabels = liftM (\a -> a{axis_labels = []})++----------------------------------------------------------------------++defaultAxisLineStyle = solidLine 1 0 0 0+defaultGridLineStyle = dashedLine 1 [5,5] 0.8 0.8 0.8++defaultAxis = Axis {+    axis_viewport = vmap (0,1),+    axis_ticks = [(0,10),(1,10)],+    axis_labels = [],+    axis_grid = [0.0,0.5,1.0],+    axis_label_gap =10,+    axis_line_style = defaultAxisLineStyle,+    axis_label_style = defaultFontStyle,+    axis_grid_style = defaultGridLineStyle+}++----------------------------------------------------------------------++refClockTime = toClockTime CalendarTime {+    ctYear=1970,+    ctMonth=toEnum 0,+    ctDay=1,+    ctHour=0,+    ctMin=0,+    ctSec=0,+    ctPicosec=0,+    ctTZ=0,+    ctWDay=Monday,+    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 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+    }++-- | An axis that plots dates, with ticks and labels corresponding to+-- calendar months. The values to be plotted against this axis can+-- be created with 'doubleFromClockTime'+monthsAxis :: Axis -> AxisFn+monthsAxis a pts = Just axis+  where+    axis =  a {+        axis_viewport=newViewport,+	axis_ticks=newTicks,+	axis_labels=newLabels,+	axis_grid=newGrid+	}+    (min,max) = case pts of+		[] -> (refClockTime, nextMonthStart refClockTime)+		ps -> let min = minimum ps+			  max = maximum ps in+			  (clockTimeFromDouble min,clockTimeFromDouble max)+    min' = thisMonthStart min+    max' = nextMonthStart max++    newViewport = vmap (doubleFromClockTime min', doubleFromClockTime max')+    months = takeWhile (<=max') (iterate nextMonthStart min')+    newTicks = [ (doubleFromClockTime ct,5) | ct <- months ]+    newLabels = [ (mlabelv m1 m2, mlabelt m1) | (m1,m2) <- zip months (tail months) ]+    newGrid = case axis_grid a of +        [] -> []+        _  -> [v | (v,_) <- newTicks]++    mlabelt m =  formatCalendarTime defaultTimeLocale "%b-%y" (toUTCTime m)+    mlabelv m1 m2 = (doubleFromClockTime m2 + doubleFromClockTime m1) / 2++thisMonthStart ct = +    let calt = (toUTCTime ct) {+            ctDay=1,+	    ctHour=0,+	    ctMin=0,+	    ctSec=0,+	    ctPicosec=0+        } in+        toClockTime calt++nextMonthStart ct =+    let month1 = noTimeDiff{tdMonth=1} in+	addToClockTime month1 (thisMonthStart ct)+
+ Graphics/Rendering/Chart/Gtk.hs view
@@ -0,0 +1,42 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Gtk+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)++module Graphics.Rendering.Chart.Gtk(+    renderableToWindow+    ) where++import qualified Graphics.UI.Gtk as G+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Renderable++renderableToWindow :: Renderable -> Int -> Int -> IO ()+renderableToWindow chart windowWidth windowHeight = do+    G.initGUI+    window <- G.windowNew+    canvas <- G.drawingAreaNew+    -- fix size+    --   G.windowSetResizable window False+    G.widgetSetSizeRequest window windowWidth windowHeight+    -- press any key to quit+    G.onKeyPress window $ const (do G.widgetDestroy window; return True)+    G.onDestroy window G.mainQuit+    G.onExpose canvas $ const (updateCanvas chart canvas)+    G.set window [G.containerChild G.:= canvas]+    G.widgetShowAll window+    G.mainGUI++updateCanvas :: Renderable -> G.DrawingArea  -> IO Bool+updateCanvas chart canvas = do+    win <- G.widgetGetDrawWindow canvas+    (width, height) <- G.widgetGetSize canvas+    let rect = Rect (Point 0 0) (Point (fromIntegral width) (fromIntegral height))+    G.renderWithDrawable win (rfn rect)+    return True+  where+    rfn rect = do+        alignPixels+	render chart rect
+ Graphics/Rendering/Chart/Layout.hs view
@@ -0,0 +1,175 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Layout+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)++module Graphics.Rendering.Chart.Layout where++import qualified Graphics.Rendering.Cairo as C++import Graphics.Rendering.Chart.Axis+import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Plot+import Graphics.Rendering.Chart.Renderable++data HAxis = HA_Top | HA_Bottom deriving (Eq)+data VAxis = VA_Left | VA_Right deriving (Eq)++-- | A Layout1 value is a single plot area, with optional: axes on+-- each of the 4 sides; title at the top; legend at the bottom.+data Layout1 = Layout1 {+    layout1_background :: CairoFillStyle,+    layout1_title :: String,+    layout1_title_style :: CairoFontStyle,+    layout1_horizontal_axes :: AxesFn,+    layout1_vertical_axes :: AxesFn,+    layout1_margin :: Double,+    layout1_plots :: [(String,HAxis,VAxis,Plot)],+    layout1_legend :: Maybe(LegendStyle)+}++instance ToRenderable Layout1 where+    toRenderable = layout1ToRenderable++layout1ToRenderable l =+    fillBackground (layout1_background l) (+        vertical [+            (0, addMargins (lm/2,0,0,0)    (mkTitle l)),+	    (1, addMargins (lm/2,lm,lm,lm) (plotArea l)),+	    (0, horizontal [ (0, mkLegend VA_Left l), (1,emptyRenderable), (0, mkLegend VA_Right l) ] )+            ]+        )+  where+    lm = layout1_margin l++    mkTitle l = label (layout1_title_style l) HTA_Centre VTA_Centre (layout1_title l)++    mkLegend va l = case (layout1_legend l) of+        Nothing -> emptyRenderable+        (Just ls) -> case [(s,p) | (s,_,va',p) <- layout1_plots l, va' == va, not (null s)] of+ 	    [] -> emptyRenderable+	    ps -> addMargins (0,lm,lm,0) (toRenderable (Legend True ls ps))+ +    plotArea l = Renderable {+        minsize=minsizePlotArea l,+        render=renderPlotArea l+    }++minsizePlotArea l = do+    (w1,h1,w2,h2) <- axisSizes l+    return (w1+w2,h1+h2)++renderPlotArea l (Rect p1 p5) = do+    let margin  = (layout1_margin l)++    (w1,h1,w2,h2) <- axisSizes l++    let p2 = p1 `pvadd` (Vector w1 h1)+    let p4  = p5+    let p3  = p4 `pvsub` (Vector w2 h2)+    let plotRect = (Rect p2 p3)++    -- render the plots+    C.save+    setClipRegion p2 p3 +    mapM_ (rPlot plotRect) (layout1_plots l)+    C.restore++    -- render the axes grids+    rMAxisG tAxis plotRect+    rMAxisG bAxis plotRect+    rMAxisG lAxis plotRect+    rMAxisG rAxis plotRect++    -- render the axes+    rMAxis tAxis (mkrect p2 p1 p3 p2)+    rMAxis bAxis (mkrect p2 p3 p3 p4)+    rMAxis lAxis (mkrect p1 p2 p2 p3)+    rMAxis rAxis (mkrect p3 p2 p4 p3)++  where+    (bAxis,lAxis,tAxis,rAxis) = getAxes l++    rMAxisG :: Maybe AxisT ->  Rect -> C.Render ()+    rMAxisG (Just at) rect = renderAxisGrid at rect+    rMAxisG Nothing  _ = return ()++    rMAxis :: Maybe AxisT ->  Rect -> C.Render ()+    rMAxis (Just at) rect = render (toRenderable at) rect+    rMAxis Nothing  _ = return ()++    rPlot :: Rect -> (String,HAxis,VAxis,Plot) -> C.Render ()+    rPlot rect (_,ha,va,p) = +        let mxaxis = case ha of HA_Bottom -> bAxis+				HA_Top    -> tAxis+	    myaxis = case va of VA_Left   -> lAxis+				VA_Right  -> rAxis+        in rPlot1 rect mxaxis myaxis p+	      +    rPlot1 :: Rect -> Maybe AxisT -> Maybe AxisT -> Plot -> C.Render ()+    rPlot1 (Rect dc1 dc2) (Just (AxisT _ xaxis)) (Just (AxisT _ yaxis)) p = +	let xrange = (p_x dc1, p_x dc2)+	    yrange = (p_y dc2, p_y dc1)+	    pmfn (Point x y) = Point (axis_viewport xaxis xrange x) (axis_viewport yaxis yrange y)+	in plot_render p pmfn+    rPlot1 _ _ _ _ = return ()++axisSizes l = do+    w1a <- asize fst lAxis+    h1a <- asize snd tAxis+    w2a <- asize fst rAxis+    h2a <- asize snd bAxis+    (h1b,h2b) <- aohang lAxis+    (w1b,w2b) <- aohang tAxis+    (h1c,h2c) <- aohang rAxis+    (w1c,w2c) <- aohang bAxis++    return (maximum [w1a,w1b,w1c],+	    maximum [h1a,h1b,h1c],+	    maximum [w2a,w2b,w2c],+	    maximum [h2a,h2b,h2c] )+  where+    (bAxis,lAxis,tAxis,rAxis) = getAxes l++    asize xyfn Nothing = return 0+    asize xyfn (Just at) = do+        sz <- minsize (toRenderable at)+	return (xyfn sz)++    aohang Nothing = return (0,0)+    aohang (Just a) = axisOverhang a+++getAxes :: Layout1 -> (Maybe AxisT, Maybe AxisT, Maybe AxisT, Maybe AxisT)+getAxes l = (mk E_Bottom bAxis, mk E_Left lAxis,+	     mk E_Top tAxis, mk E_Right rAxis)+  where +    (xvals0,xvals1,yvals0,yvals1) = allPlottedValues (layout1_plots l)+    (bAxis,tAxis) = layout1_horizontal_axes l xvals0 xvals1+    (lAxis,rAxis) = layout1_vertical_axes l yvals0 yvals1+    mk _ Nothing = Nothing+    mk at (Just a) = Just (AxisT at a)+++allPlottedValues :: [(String,HAxis,VAxis,Plot)] -> ( [Double], [Double], [Double], [Double] )+allPlottedValues plots = (xvals0,xvals1,yvals0,yvals1)+  where+    pts = concat [ [ (ha,va,pt)| pt <- plot_all_points p] | (_,ha,va,p) <- plots ]+    xvals0 = [ (p_x pt) | (HA_Bottom,_,pt) <- pts  ]+    xvals1 = [ (p_x pt) | (HA_Top,_,pt) <- pts  ]+    yvals0 = [ (p_y pt) | (_,VA_Left,pt) <- pts  ]+    yvals1 = [ (p_y pt) | (_,VA_Right,pt) <- pts  ]+++defaultLayout1 = Layout1 {+    layout1_background = solidFillStyle 1 1 1,+    layout1_title = "",+    layout1_title_style = fontStyle "sans" 15 C.FontSlantNormal C.FontWeightBold,+    layout1_horizontal_axes = linkedAxes (autoScaledAxis defaultAxis),+    layout1_vertical_axes = linkedAxes (autoScaledAxis defaultAxis),+    layout1_margin = 10,+    layout1_plots = [],+    layout1_legend = Just defaultLegendStyle+}+
+ Graphics/Rendering/Chart/Plot.hs view
@@ -0,0 +1,178 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Plot+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)++module Graphics.Rendering.Chart.Plot(+    Plot(..),+    ToPlot(..),+    PlotPoints(..),+    PlotLines(..),+    PlotFillBetween(..),++    defaultPlotLineStyle,+    defaultPlotPoints,+    defaultPlotFillBetween,+    defaultPlotLines+    +    ) where++import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart.Types+import Control.Monad++-- | Interface to control plotting on a 2D area.+data Plot = Plot {++    -- | Given the mapping between model space coordinates and device coordinates,+    -- render this plot into a chart.+    plot_render :: PointMapFn -> C.Render (),++    -- | Render a small sample of this plot into the given rectangle.+    -- This is for used to generate a the legend a chart.+    plot_render_legend :: Rect -> C.Render (),++    -- | All of the model space coordinates to be plotted. These are+    -- used to autoscale the axes where necessary.+    plot_all_points :: [Point]+};++-- | a type class abstracting the conversion of a value to a Plot.+class ToPlot a where+   toPlot :: a -> Plot++----------------------------------------------------------------------++-- | Value defining a series of (possibly disjointed) lines,+-- and a style in which to render them+data PlotLines = PlotLines {+    plot_lines_style :: CairoLineStyle,+    plot_lines_values :: [[Point]]+}++instance ToPlot PlotLines where+    toPlot p = Plot {+        plot_render = renderPlotLines p,+	plot_render_legend = renderPlotLegendLines p,+	plot_all_points = concat (plot_lines_values p)+    }++renderPlotLines :: PlotLines -> PointMapFn -> C.Render ()+renderPlotLines p pmap = do+    C.save+    setLineStyle (plot_lines_style p)+    mapM_ drawLines (plot_lines_values p)+    C.restore+  where+    drawLines (p:ps) = do+	moveTo (pmap p)+	mapM_ (\p -> lineTo (pmap p)) ps+	C.stroke++renderPlotLegendLines :: PlotLines -> Rect -> C.Render ()+renderPlotLegendLines p r@(Rect p1 p2) = do+    C.save+    setLineStyle (plot_lines_style p)+    let y = (p_y p1 + p_y p2) / 2+    moveTo (Point (p_x p1) y)+    lineTo (Point (p_x p2) y)+    C.stroke+    C.restore++defaultPlotLineStyle = solidLine 1 0 0 1++defaultPlotLines = PlotLines {+    plot_lines_style = defaultPlotLineStyle,+    plot_lines_values = []+}+----------------------------------------------------------------------++-- | Value defining a series of datapoints, and a style in+-- which to render them+data PlotPoints = PlotPoints {+    plot_points_style :: CairoPointStyle,+    plot_points_values :: [Point]+}++instance ToPlot PlotPoints where+    toPlot p = Plot {+        plot_render = renderPlotPoints p,+	plot_render_legend = renderPlotLegendPoints p,+	plot_all_points = plot_points_values p+    }++renderPlotPoints :: PlotPoints -> PointMapFn -> C.Render ()+renderPlotPoints p pmap = do+    C.save+    mapM_ (drawPoint.pmap) (plot_points_values p)+    C.restore+  where+    (CairoPointStyle drawPoint) = (plot_points_style p)+++renderPlotLegendPoints :: PlotPoints -> Rect -> C.Render ()+renderPlotLegendPoints p r@(Rect p1 p2) = do+    C.save+    drawPoint (Point (p_x p1) ((p_y p1 + p_y p2)/2))+    drawPoint (Point ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2))+    drawPoint (Point (p_x p2) ((p_y p1 + p_y p2)/2))+    C.restore++  where+    (CairoPointStyle drawPoint) = (plot_points_style p)++defaultPlotPoints = PlotPoints {+    plot_points_style =defaultPointStyle,+    plot_points_values = []+}+----------------------------------------------------------------------+-- | Value specifying a plot filling the area between two sets of Y+-- coordinates, given common X coordinates.++data PlotFillBetween = PlotFillBetween {+    plot_fillbetween_style :: CairoFillStyle,+    plot_fillbetween_values :: [ (Double, (Double,Double))]+}++instance ToPlot PlotFillBetween where+    toPlot p = Plot {+        plot_render = renderPlotFillBetween p,+	plot_render_legend = renderPlotLegendFill p,+	plot_all_points = plotAllPointsFillBetween p+    }++renderPlotFillBetween :: PlotFillBetween -> PointMapFn -> C.Render ()+renderPlotFillBetween p pmap = renderPlotFillBetween' p (plot_fillbetween_values p) pmap++renderPlotFillBetween' p [] _ = return ()+renderPlotFillBetween' p vs pmap  = do+    C.save+    setFillStyle (plot_fillbetween_style p)+    moveTo p0+    mapM_ lineTo p1s+    mapM_ lineTo (reverse p2s)+    lineTo p0+    C.fill+    C.restore+  where+    (p0:p1s) = map pmap [ Point x y1 | (x,(y1,y2)) <- vs ]+    p2s = map pmap [ Point x y2 | (x,(y1,y2)) <- vs ]++renderPlotLegendFill :: PlotFillBetween -> Rect -> C.Render ()+renderPlotLegendFill p r = do+    C.save+    setFillStyle (plot_fillbetween_style p)+    rectPath r+    C.fill+    C.restore++plotAllPointsFillBetween :: PlotFillBetween -> [Point]+plotAllPointsFillBetween p = concat [ [Point x y1, Point x y2]+				      | (x,(y1,y2)) <- plot_fillbetween_values p]+++defaultPlotFillBetween = PlotFillBetween {+    plot_fillbetween_style=solidFillStyle 0.5 0.5 1.0,+    plot_fillbetween_values=[]+}
+ Graphics/Rendering/Chart/Renderable.hs view
@@ -0,0 +1,234 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Renderable+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)++module Graphics.Rendering.Chart.Renderable where++import qualified Graphics.Rendering.Cairo as C+import Control.Monad++import Graphics.Rendering.Chart.Types+import Graphics.Rendering.Chart.Plot++-- | A Renderable is a record of functions required to layout a+-- graphic element.+data Renderable = Renderable {++   -- | a Cairo action to calculate a minimum size,+   minsize :: C.Render RectSize,++   -- | a Cairo action for drawing it within a specified rectangle.+   render ::  Rect -> C.Render ()+}++-- | A type class abtracting the conversion of a value to a+-- Renderable.++class ToRenderable a where+   toRenderable :: a -> Renderable++emptyRenderable = Renderable {+   minsize = return (0,0),+   render  = \_ -> return ()+}++addMargins :: (Double,Double,Double,Double) -> Renderable -> Renderable+addMargins (t,b,l,r) rd = Renderable { minsize = mf, render = rf }+  where+    mf = do+        (w,h) <- minsize rd+        return (w+l+r,h+t+b)++    rf r1@(Rect p1 p2) = do+        render rd (Rect (p1 `pvadd` (Vector l t)) (p2 `pvsub` (Vector r b)))++fillBackground :: CairoFillStyle -> Renderable -> Renderable+fillBackground fs r = Renderable { minsize = minsize r, render = rf }+  where+    rf rect@(Rect p1 p2) = do+        C.save+        setClipRegion p1 p2+        setFillStyle fs+        C.paint+        C.restore+	render r rect++vertical, horizontal :: [(Double,Renderable)] -> Renderable +vertical rs = Renderable { minsize = mf, render = rf }+  where+    mf = do+        (_,wmin,hmin) <- calcSizes+	return (wmin, hmin)++    rf (Rect p1 p2) = do+        (sizes,wmin,hmin) <- calcSizes+	let wactual = p_x p2 - p_x p1+	let hextra = p_y p2 - p_y p1 - hmin+	let etotal = sum (map fst rs)+	let rs' = [ (wactual,h + hextra * e / etotal,r)+		    | ((e,r),(w,h)) <- zip rs sizes ]+	foldM_ render1 p1 rs'++    calcSizes = do+        sizes <- mapM minsize [ r | (_,r) <- rs]+	let wmin = maximum [ w | (w,h) <- sizes ]+	let hmin = sum [ h | (w,h) <- sizes ]+	return (sizes,wmin,hmin)+    +    render1 :: Point -> (Double,Double,Renderable) -> C.Render Point+    render1 p (w,h,r) = do+        render r (Rect p (p `pvadd` Vector w h))+	return (p `pvadd` Vector 0 h)++horizontal rs = Renderable { minsize = mf, render = rf }+  where+    mf = do+        (_,wmin,hmin) <- calcSizes+	return (wmin, hmin)++    rf (Rect p1 p2) = do+        (sizes,wmin,hmin) <- calcSizes+	let hactual = p_y p2 - p_y p1+	let wextra = p_x p2 - p_x p1 - wmin+	let etotal = sum (map fst rs)+	let rs' = [ (w + wextra * e / etotal,hactual,r)+		    | ((e,r),(w,h)) <- zip rs sizes ]+	foldM_ render1 p1 rs'++    calcSizes = do+        sizes <- mapM minsize [ r | (_,r) <- rs]+	let hmin = maximum [ h | (w,h) <- sizes ]+	let wmin = sum [ w | (w,h) <- sizes ]+	return (sizes,wmin,hmin)+    +    render1 :: Point -> (Double,Double,Renderable) -> C.Render Point+    render1 p (w,h,r) = do+        render r (Rect p (p `pvadd` Vector w h))+	return (p `pvadd` Vector w 0)++renderableToPNGFile :: Renderable -> Int -> Int -> FilePath -> IO ()+renderableToPNGFile chart width height path = +    C.withImageSurface C.FormatARGB32 width height $ \result -> do+    C.renderWith result $ rfn+    C.surfaceWriteToPNG result path+  where+    rfn = do+        alignPixels+	render chart rect++    rect = Rect (Point 0 0) (Point (fromIntegral width) (fromIntegral height))++renderableToPDFFile :: Renderable -> Int -> Int -> FilePath -> IO ()+renderableToPDFFile chart width height path = +    C.withPDFSurface path (fromIntegral width) (fromIntegral height) $ \result -> do+    C.renderWith result $ rfn+    C.surfaceFinish result+  where+    rfn = do+	render chart rect+        C.showPage++    rect = Rect (Point 0 0) (Point (fromIntegral width) (fromIntegral height))++renderableToPSFile :: Renderable -> Int -> Int -> FilePath -> IO ()+renderableToPSFile chart width height path = +    C.withPSSurface path (fromIntegral width) (fromIntegral height) $ \result -> do+    C.renderWith result $ rfn+    C.surfaceFinish result+  where+    rfn = do+	render chart rect+        C.showPage++    rect = Rect (Point 0 0) (Point (fromIntegral width) (fromIntegral height))++alignPixels :: C.Render ()+alignPixels = do+    -- move to centre of pixels so that stroke width of 1 is+    -- exactly one pixel +    C.translate 0.5 0.5++----------------------------------------------------------------------+-- Legend++data LegendStyle = LegendStyle {+   legend_label_style :: CairoFontStyle,+   legend_margin :: Double,+   legend_plot_size :: Double+}++data Legend = Legend Bool LegendStyle [(String,Plot)]++instance ToRenderable Legend where+  toRenderable l = Renderable {+    minsize=minsizeLegend l,+    render=renderLegend l+  }++minsizeLegend :: Legend -> C.Render RectSize+minsizeLegend (Legend _ ls plots) = do+    let labels = map fst plots+    lsizes <- mapM textSize labels+    lgap <- legendSpacer+    let lm = legend_margin ls+    let pw = legend_plot_size ls+    let h = maximum  [h | (w,h) <- lsizes]+    let n = fromIntegral (length lsizes)+    let w = sum [w + lgap | (w,h) <- lsizes] + pw * (n+1) + lm * (n-1)+    return (w,h)++renderLegend :: Legend -> Rect -> C.Render ()+renderLegend (Legend _ ls plots) (Rect rp1 rp2) = do+    foldM_ rf rp1 plots+  where+    lm = legend_margin ls+    lps = legend_plot_size ls++    rf :: Point -> (String,Plot) -> C.Render Point+    rf p1 (label,plot) = do+        (w,h) <- textSize label+	lgap <- legendSpacer+	let p2 = (p1 `pvadd` Vector lps 0)+        plot_render_legend plot (mkrect p1 rp1 p2 rp2)+	let p3 = Point (p_x p2 + lgap) (p_y rp1)+	drawText HTA_Left VTA_Top p3 label+        return (p3 `pvadd` Vector (w+lm) 0)++legendSpacer = do+    (lgap,_) <- textSize "X"+    return lgap++defaultLegendStyle = LegendStyle {+    legend_label_style=defaultFontStyle,+    legend_margin=20,+    legend_plot_size=20+}+++----------------------------------------------------------------------+-- Labels++label :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> String -> Renderable+label fs hta vta s = Renderable { minsize = mf, render = rf }+  where+    mf = do+       C.save+       setFontStyle fs+       sz <- textSize s+       C.restore+       return sz+    rf (Rect p1 p2) = do+       C.save+       setFontStyle fs+       let p = Point (xp hta (p_x p1) (p_x p2)) (yp vta (p_y p1) (p_y p2))+       drawText hta vta p s+       C.restore+    xp HTA_Left x1 x2 = x1+    xp HTA_Centre x1 x2 = (x1+x2)/2+    xp HTA_Right x1 x2 = x2+    yp VTA_Top y1 y2 = y2+    yp VTA_Centre y1 y2 = (y1+y2)/2+    yp VTA_Bottom y1 y2 = y1+
+ Graphics/Rendering/Chart/Types.hs view
@@ -0,0 +1,210 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Types+-- Copyright   :  (c) Tim Docker 2006+-- License     :  BSD-style (see chart/COPYRIGHT)++module Graphics.Rendering.Chart.Types where++import qualified Graphics.Rendering.Cairo as C++-- | A point in two dimensions+data Point = Point {+    p_x :: Double,+    p_y :: Double+} deriving Show++data Vector = Vector {+    v_x :: Double,+    v_y :: Double+} deriving Show++-- | scale a vector by a constant+vscale :: Double -> Vector -> Vector+vscale c (Vector x y) = (Vector (x*c) (y*c))++-- | add a point and a vector+pvadd :: Point -> Vector -> Point+pvadd (Point x1 y1) (Vector x2 y2) = (Point (x1+x2) (y1+y2))++-- | subtract a vector from a point+pvsub :: Point -> Vector -> Point+pvsub (Point x1 y1) (Vector x2 y2) = (Point (x1-x2) (y1-y2))++-- | subtract two points+psub :: Point -> Point -> Vector+psub (Point x1 y1) (Point x2 y2) = (Vector (x1-x2) (y1-y2))++-- | a function mapping between points+type PointMapFn = Point -> Point++-- | A rectangle is defined by two points+data Rect = Rect Point Point+   deriving Show++data RectEdge = E_Top | E_Bottom | E_Left | E_Right++-- | Create a rectangle based upon the coordinates of 4 points+mkrect (Point x1 _) (Point _ y2) (Point x3 _) (Point _ y4) =+    Rect (Point x1 y2) (Point x3 y4)++-- | A linear mapping of points in one range to another+vmap :: Range -> Range -> Double -> Double+vmap (v1,v2) (v3,v4) v = v3 + (v-v1) * (v4-v3) / (v2-v1)+ +-- | Abstract data type for the style of a plotted point+--+-- The contained Cairo action draws a point in the desired+-- style, at the supplied device coordinates.+newtype CairoPointStyle = CairoPointStyle (Point -> C.Render ())++-- | 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 (C.Render ())++-- | Abstract data type for a fill style+--+-- The contained Cairo action sets the required fill+-- style in the Cairo rendering state.+newtype CairoFillStyle = CairoFillStyle (C.Render ())++-- | Abstract data type for a font.+--+-- The contained Cairo action sets the required font+-- in the Cairo rendering state.+newtype CairoFontStyle = CairoFontStyle (C.Render ())++type Range = (Double,Double)+type RectSize = (Double,Double)++----------------------------------------------------------------------+-- Assorted helper functions in Cairo Usage++moveTo, lineTo :: Point -> C.Render ()+moveTo (Point px py) = C.moveTo px py+lineTo (Point px py) = C.lineTo px py++setClipRegion p2 p3 = do    +    C.moveTo (p_x p2) (p_y p2)+    C.lineTo (p_x p2) (p_y p3)+    C.lineTo (p_x p3) (p_y p3)+    C.lineTo (p_x p3) (p_y p2)+    C.lineTo (p_x p2) (p_y p2)+    C.clip++-- | stroke the lines between successive points+strokeLines (p1:ps) = do+    C.newPath+    moveTo p1+    mapM_ lineTo ps+    C.stroke+strokeLines _ = return ()++-- | make a path from a rectable+rectPath :: Rect -> C.Render ()+rectPath (Rect (Point x1 y1) (Point x2 y2)) = do+   C.newPath+   C.moveTo x1 y1+   C.lineTo x2 y1+   C.lineTo x2 y2+   C.lineTo x1 y2+   C.lineTo x1 y1++setFontStyle (CairoFontStyle s) = s+setLineStyle (CairoLineStyle s) = s+setFillStyle (CairoFillStyle s) = s++textSize :: String -> C.Render RectSize+textSize s = do+    te <- C.textExtents s+    fe <- C.fontExtents+    return (C.textExtentsWidth te, C.fontExtentsHeight fe)++data HTextAnchor = HTA_Left | HTA_Centre | HTA_Right+data VTextAnchor = VTA_Top | VTA_Centre | VTA_Bottom | VTA_BaseLine++-- | Function to draw a textual label anchored by one of it's corners+-- or edges.+drawText :: HTextAnchor -> VTextAnchor -> Point -> String -> C.Render ()+drawText hta vta (Point x y) s = do+    te <- C.textExtents s+    fe <- C.fontExtents+    let lx = xadj hta (C.textExtentsWidth te)+    let ly = yadj vta te fe+    C.moveTo (x+lx) (y+ly)+    C.showText s+  where+    xadj HTA_Left   w = 0+    xadj HTA_Centre w = (-w/2)+    xadj HTA_Right  w = (-w)+    yadj VTA_Top    te fe = C.fontExtentsAscent fe+    yadj VTA_Centre te fe = - (C.textExtentsYbearing te) / 2+    yadj VTA_BaseLine te fe = 0+    yadj VTA_Bottom te fe = -(C.fontExtentsDescent fe)++----------------------------------------------------------------------++filledCircles ::+     Double -- ^ radius of circle+  -> Double -- ^ red component of colour+  -> Double -- ^ green component of colour+  -> Double -- ^ blue component of colour+  -> CairoPointStyle+filledCircles radius r g b = CairoPointStyle rf+  where+    rf (Point x y) = do+	C.setSourceRGB r g b+        C.newPath+	C.arc x y radius 0 360+	C.fill++solidLine ::+     Double -- ^ width of line+  -> Double -- ^ red component of colour+  -> Double -- ^ green component of colour+  -> Double -- ^ blue component of colour+  -> CairoLineStyle+solidLine w r g b = CairoLineStyle (do+    C.setLineWidth w+    C.setSourceRGB r g b+    )++dashedLine ::+     Double   -- ^ width of line+  -> [Double] -- ^ the dash pattern in device coordinates+  -> Double   -- ^ red component of colour+  -> Double   -- ^ green component of colour+  -> Double   -- ^ blue component of colour+  -> CairoLineStyle+dashedLine w dashes r g b = CairoLineStyle (do+    C.setDash dashes 0+    C.setLineWidth w+    C.setSourceRGB r g b+    )++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.selectFontFace name slant weight+	 C.setFontSize size++solidFillStyle ::+     Double         -- ^ red component of colour+  -> Double         -- ^ green component of colour+  -> Double         -- ^ blue component of colour+  -> CairoFillStyle+solidFillStyle r g b = CairoFillStyle fn+   where fn = C.setSourceRGB r g b++defaultPointStyle = filledCircles 1 1 1 1+defaultFontStyle = CairoFontStyle (return ())++isValidNumber v = not (isNaN v) && not (isInfinite v)
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2006, Tim Docker++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,8 @@+#!/usr/bin/env runghc++module Main where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ tests/Prices.hs view
@@ -0,0 +1,236 @@+module Prices where++prices :: [(Int,Int,Int,Double,Double)]+prices = [+    (03,05,2005, 16.18, 42.02),+    (04,05,2005, 16.25, 42.31),+    (05,05,2005, 16.50, 42.95),+    (06,05,2005, 16.52, 43.50),+    (09,05,2005, 16.84, 44.91),+    (10,05,2005, 16.70, 44.55),+    (11,05,2005, 16.43, 43.63),+    (12,05,2005, 16.29, 43.18),+    (13,05,2005, 15.95, 42.40),+    (16,05,2005, 15.55, 41.65),+    (17,05,2005, 15.71, 42.17),+    (18,05,2005, 15.93, 42.37),+    (19,05,2005, 16.20, 42.85),+    (20,05,2005, 15.88, 42.30),+    (23,05,2005, 15.92, 42.53),+    (24,05,2005, 16.25, 42.81),+    (25,05,2005, 16.20, 42.67),+    (26,05,2005, 16.05, 42.35),+    (27,05,2005, 16.45, 43.12),+    (30,05,2005, 16.85, 43.24),+    (31,05,2005, 16.68, 42.57),+    (01,06,2005, 16.85, 43.22),+    (02,06,2005, 17.17, 43.85),+    (03,06,2005, 17.42, 44.15),+    (06,06,2005, 17.50, 44.07),+    (07,06,2005, 17.37, 43.76),+    (08,06,2005, 17.15, 43.21),+    (09,06,2005, 17.12, 43.42),+    (10,06,2005, 17.15, 43.27),+    (14,06,2005, 17.34, 43.30),+    (15,06,2005, 17.46, 43.90),+    (16,06,2005, 17.71, 44.43),+    (17,06,2005, 18.25, 45.45),+    (20,06,2005, 18.23, 45.16),+    (21,06,2005, 18.26, 45.54),+    (22,06,2005, 18.11, 45.06),+    (23,06,2005, 17.79, 44.65),+    (24,06,2005, 17.76, 44.43),+    (27,06,2005, 17.63, 44.22),+    (28,06,2005, 18.08, 44.94),+    (29,06,2005, 18.13, 44.80),+    (30,06,2005, 18.15, 44.82),+    (01,07,2005, 18.09, 45.12),+    (04,07,2005, 18.20, 45.20),+    (05,07,2005, 18.45, 45.85),+    (06,07,2005, 18.40, 45.91),+    (07,07,2005, 18.60, 46.35),+    (08,07,2005, 18.38, 45.76),+    (11,07,2005, 18.80, 46.41),+    (12,07,2005, 18.60, 45.86),+    (13,07,2005, 18.73, 46.00),+    (14,07,2005, 18.70, 46.44),+    (15,07,2005, 18.67, 46.25),+    (18,07,2005, 18.54, 45.77),+    (19,07,2005, 18.20, 45.21),+    (20,07,2005, 18.65, 46.13),+    (21,07,2005, 19.00, 46.87),+    (22,07,2005, 19.09, 47.32),+    (25,07,2005, 19.22, 47.36),+    (26,07,2005, 19.19, 47.66),+    (27,07,2005, 19.17, 47.64),+    (28,07,2005, 19.15, 47.98),+    (29,07,2005, 19.36, 49.12),+    (01,08,2005, 19.40, 49.30),+    (02,08,2005, 19.30, 49.17),+    (03,08,2005, 19.52, 49.91),+    (04,08,2005, 19.80, 50.60),+    (05,08,2005, 19.60, 50.40),+    (08,08,2005, 19.92, 50.94),+    (09,08,2005, 20.34, 52.09),+    (10,08,2005, 20.45, 51.42),+    (11,08,2005, 20.74, 52.30),+    (12,08,2005, 21.05, 53.01),+    (15,08,2005, 21.16, 53.02),+    (16,08,2005, 20.90, 52.74),+    (17,08,2005, 20.55, 51.93),+    (18,08,2005, 20.28, 51.42),+    (19,08,2005, 20.68, 52.20),+    (22,08,2005, 21.22, 53.10),+    (23,08,2005, 21.07, 53.01),+    (24,08,2005, 20.56, 52.72),+    (25,08,2005, 19.90, 50.45),+    (26,08,2005, 20.60, 51.42),+    (29,08,2005, 20.03, 50.10),+    (30,08,2005, 20.47, 50.74),+    (31,08,2005, 20.46, 50.31),+    (01,09,2005, 20.93, 51.80),+    (02,09,2005, 20.83, 51.60),+    (05,09,2005, 20.46, 51.56),+    (06,09,2005, 20.25, 50.60),+    (07,09,2005, 20.55, 51.54),+    (08,09,2005, 20.03, 50.55),+    (09,09,2005, 20.19, 50.90),+    (12,09,2005, 20.20, 51.27),+    (13,09,2005, 20.47, 51.91),+    (14,09,2005, 20.59, 51.59),+    (15,09,2005, 20.70, 52.44),+    (16,09,2005, 20.99, 53.77),+    (19,09,2005, 21.39, 55.45),+    (20,09,2005, 21.53, 55.88),+    (21,09,2005, 20.89, 54.63),+    (22,09,2005, 21.41, 55.50),+    (23,09,2005, 21.30, 55.56),+    (26,09,2005, 21.86, 57.55),+    (27,09,2005, 22.01, 58.56),+    (28,09,2005, 21.81, 58.26),+    (29,09,2005, 22.48, 60.01),+    (30,09,2005, 22.25, 59.14),+    (03,10,2005, 22.30, 58.93),+    (04,10,2005, 22.20, 58.61),+    (05,10,2005, 21.45, 57.10),+    (06,10,2005, 20.76, 56.30),+    (07,10,2005, 20.47, 56.50),+    (10,10,2005, 20.72, 57.25),+    (11,10,2005, 20.33, 57.00),+    (12,10,2005, 20.83, 57.48),+    (13,10,2005, 20.47, 56.69),+    (14,10,2005, 19.98, 55.21),+    (17,10,2005, 20.05, 55.95),+    (18,10,2005, 20.75, 57.90),+    (19,10,2005, 20.05, 56.19),+    (20,10,2005, 20.01, 56.30),+    (21,10,2005, 20.03, 55.82),+    (24,10,2005, 19.77, 54.27),+    (25,10,2005, 20.09, 54.82),+    (26,10,2005, 20.42, 55.58),+    (27,10,2005, 20.49, 55.80),+    (28,10,2005, 20.10, 54.94),+    (31,10,2005, 20.75, 56.31),+    (01,11,2005, 20.89, 57.00),+    (02,11,2005, 20.70, 57.11),+    (03,11,2005, 21.28, 58.39),+    (04,11,2005, 21.35, 58.60),+    (07,11,2005, 21.09, 58.18),+    (08,11,2005, 21.35, 59.80),+    (09,11,2005, 21.03, 59.25),+    (10,11,2005, 21.11, 59.21),+    (11,11,2005, 21.12, 59.71),+    (14,11,2005, 21.60, 61.24),+    (15,11,2005, 21.53, 60.96),+    (16,11,2005, 21.42, 60.60),+    (17,11,2005, 21.40, 60.79),+    (18,11,2005, 21.85, 62.45),+    (21,11,2005, 21.71, 62.60),+    (22,11,2005, 21.67, 61.70),+    (23,11,2005, 21.55, 60.70),+    (24,11,2005, 21.86, 61.89),+    (25,11,2005, 22.02, 62.21),+    (28,11,2005, 22.22, 62.09),+    (29,11,2005, 21.83, 61.35),+    (30,11,2005, 21.87, 61.76),+    (01,12,2005, 21.50, 60.40),+    (02,12,2005, 21.95, 61.92),+    (05,12,2005, 22.03, 63.33),+    (06,12,2005, 21.83, 62.99),+    (07,12,2005, 21.85, 63.84),+    (08,12,2005, 21.56, 63.10),+    (09,12,2005, 21.80, 63.55),+    (12,12,2005, 21.92, 63.60),+    (13,12,2005, 21.65, 63.35),+    (14,12,2005, 21.72, 63.15),+    (15,12,2005, 21.69, 63.16),+    (16,12,2005, 21.60, 62.63),+    (19,12,2005, 21.87, 63.81),+    (20,12,2005, 22.10, 65.50),+    (21,12,2005, 22.50, 67.18),+    (22,12,2005, 22.49, 67.75),+    (23,12,2005, 22.58, 68.50),+    (28,12,2005, 22.59, 68.25),+    (29,12,2005, 22.93, 69.10),+    (30,12,2005, 22.75, 69.00),+    (03,01,2006, 23.18, 69.90),+    (04,01,2006, 23.85, 71.06),+    (05,01,2006, 23.60, 69.80),+    (06,01,2006, 23.35, 68.80),+    (09,01,2006, 24.06, 70.18),+    (10,01,2006, 23.85, 69.15),+    (11,01,2006, 23.88, 69.35),+    (12,01,2006, 23.80, 70.19),+    (13,01,2006, 23.73, 70.50),+    (16,01,2006, 23.74, 71.05),+    (17,01,2006, 23.96, 71.94),+    (18,01,2006, 23.73, 70.25),+    (19,01,2006, 24.45, 72.50),+    (20,01,2006, 24.66, 74.00),+    (23,01,2006, 24.47, 73.25),+    (24,01,2006, 24.84, 74.25),+    (25,01,2006, 25.08, 73.96),+    (27,01,2006, 26.05, 76.10),+    (30,01,2006, 26.58, 78.45),+    (31,01,2006, 25.80, 75.82),+    (01,02,2006, 25.99, 75.21),+    (02,02,2006, 25.50, 74.98),+    (03,02,2006, 25.53, 74.75),+    (06,02,2006, 25.85, 75.57),+    (07,02,2006, 25.70, 75.06),+    (08,02,2006, 24.37, 72.75),+    (09,02,2006, 24.68, 72.77),+    (13,02,2006, 23.88, 70.95),+    (14,02,2006, 24.16, 72.37),+    (15,02,2006, 24.35, 71.84),+    (16,02,2006, 24.29, 71.89),+    (17,02,2006, 23.88, 71.65),+    (20,02,2006, 24.54, 74.90),+    (21,02,2006, 24.98, 75.50),+    (22,02,2006, 24.90, 73.24),+    (23,02,2006, 25.28, 74.69),+    (24,02,2006, 24.55, 72.20),+    (27,02,2006, 24.66, 73.00),+    (28,02,2006, 24.25, 71.20),+    (01,03,2006, 24.03, 70.25),+    (02,03,2006, 24.45, 70.50),+    (03,03,2006, 24.34, 70.35),+    (06,03,2006, 24.51, 70.85),+    (08,03,2006, 23.60, 67.95),+    (09,03,2006, 23.70, 68.65),+    (10,03,2006, 23.37, 67.50),+    (13,03,2006, 23.93, 70.36),+    (14,03,2006, 23.64, 69.45),+    (15,03,2006, 23.90, 69.40),+    (16,03,2006, 24.46, 70.90),+    (17,03,2006, 24.70, 71.25),+    (20,03,2006, 25.24, 72.85),+    (21,03,2006, 25.32, 73.08),+    (22,03,2006, 25.18, 72.99),+    (23,03,2006, 25.57, 74.34),+    (24,03,2006, 25.92, 75.23),+    (27,03,2006, 26.78, 77.05),+    (28,03,2006, 26.85, 77.13),+    (30,03,2006, 27.60, 77.96),+    (31,03,2006, 28.00, 78.85)+    ]
+ tests/test.hs view
@@ -0,0 +1,196 @@+import qualified Graphics.Rendering.Cairo as C+import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Gtk+import System.Environment(getArgs)+import System.Time+import System.Random+import Prices++data OutputType = Window | PNG | PS | PDF++chooseLineWidth Window = 1.0+chooseLineWidth PNG = 1.0+chooseLineWidth PDF = 0.25+chooseLineWidth PS = 0.25++----------------------------------------------------------------------+test1 :: OutputType -> IO Layout1+test1 otype = return 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 0 0 1+    }++    sinusoid2 = defaultPlotPoints {+        plot_points_style=filledCircles 2 1 0 0,+	plot_points_values = [ (Point x (am x)) | x <- [0,7..400]]+    }++    layout = defaultLayout1 {+        layout1_title="Amplitude Modulation",			   +        layout1_horizontal_axes=linkedAxes (autoScaledAxis defaultAxis),+	layout1_vertical_axes=linkedAxes (autoScaledAxis defaultAxis),+	layout1_plots = [("am",HA_Bottom,VA_Left,(toPlot sinusoid1)),+			 ("am points", HA_Bottom,VA_Left,(toPlot sinusoid2))]+    }++    lineWidth = chooseLineWidth otype++----------------------------------------------------------------------+test2 :: OutputType -> IO Layout1+test2 otype = return layout +  where++    price1 = defaultPlotLines {+        plot_lines_style = solidLine lineWidth 0 0 1,+	plot_lines_values = [[ Point (date d m y) v | (d,m,y,v,_) <- prices]]+    }++    price2 = defaultPlotLines {+        plot_lines_style = solidLine lineWidth 0 1 0,+	plot_lines_values = [[ Point (date d m y) v | (d,m,y,_,v) <- prices]]+    }++    gridlessAxis = defaultAxis{axis_grid=[]}+    vaxis = autoScaledAxis gridlessAxis++    layout = defaultLayout1 {+        layout1_title="Price History",			   +        layout1_horizontal_axes=linkedAxes' (monthsAxis gridlessAxis),+	layout1_vertical_axes=independentAxes vaxis vaxis,+ 	layout1_plots = [("price 1", HA_Bottom,VA_Left,(toPlot price1)),+                         ("price 2", HA_Bottom,VA_Right,(toPlot price2))]+    }++    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+    }++----------------------------------------------------------------------+test3 :: OutputType -> IO Layout1+test3 otype = return layout +  where++    price1 = defaultPlotFillBetween {+        plot_fillbetween_style = solidFillStyle 0.5 1 0.5,+	plot_fillbetween_values = [ (date d m y,(0,v2)) | (d,m,y,v1,v2) <- prices]+    }++    price2 = defaultPlotFillBetween {+        plot_fillbetween_style = solidFillStyle 0.5 0.5 1,+	plot_fillbetween_values = [ (date d m y,(0,v1)) | (d,m,y,v1,v2) <- prices]+    }++    layout = defaultLayout1 {+        layout1_title="Price History",			   +        layout1_horizontal_axes=linkedAxes' (monthsAxis defaultAxis),+	layout1_vertical_axes=linkedAxes' (autoScaledAxis defaultAxis),+ 	layout1_plots = [("price 1", HA_Bottom,VA_Left,(toPlot price1)),+                         ("price 2", HA_Bottom,VA_Left,(toPlot price2))]+    }++----------------------------------------------------------------------        +test4 :: OutputType -> IO Layout1+test4 otype = return layout +  where++    points = defaultPlotPoints {+        plot_points_style=filledCircles 3 1 0 0,+	plot_points_values = [ Point x (10**x) | x <- [0.5,1,1.5,2,2.5] ]+    }++    lines = defaultPlotLines {+	plot_lines_values = [ [Point x (10**x) | x <- [0,3]] ]+    }++    layout = defaultLayout1 {+        layout1_title="Log/Linear Example",			   +        layout1_horizontal_axes=linkedAxes (autoScaledAxis defaultAxis),+	layout1_vertical_axes=linkedAxes (autoScaledLogAxis defaultAxis),+	layout1_plots = [("values",HA_Bottom,VA_Left,(toPlot points)),+			 ("values",HA_Bottom,VA_Left,(toPlot lines)) ]+    }+++----------------------------------------------------------------------+-- Example thanks to Russell O'Connor++test5 :: OutputType -> IO Layout1+test5 otype = do+    bits <- fmap randoms getStdGen+    return (layout 1001 (trial bits))+  where+    layout n t = defaultLayout1 {+           layout1_title="Simulation of betting on a biased coin",			   +           layout1_horizontal_axes=linkedAxes (autoScaledAxis defaultAxis),+            layout1_vertical_axes=linkedAxes (autoScaledLogAxis defaultAxis),+            layout1_plots = [+             ("f=0.05",HA_Bottom,VA_Left,(toPlot (plot s1 n 0 (t 0.05)))),+             ("f=0.1",HA_Bottom,VA_Left,(toPlot (plot s2 n 0 (t 0.1))))]+        }++    plot s n m t = defaultPlotLines {+            plot_lines_style = s,+            plot_lines_values =+             [[Point (fromIntegral x) y | (x,y) <-+                          filter (\(x,_)->x `mod` (m+1)==0) $ take n $ zip [0..] t]]+        }++    b = 0.1++    trial bits frac = scanl (*) 1 (map f bits)+      where +        f True = (1+frac*(1+b))+        f False = (1-frac)++    s1 = solidLine lineWidth 0 1 0+    s2 = solidLine lineWidth 0 0 1++    lineWidth = chooseLineWidth otype++----------------------------------------------------------------------        +allTests =+     [ ("test1",test1)+     , ("test2",test2)+     , ("test3",test3)+     , ("test4",test4)+     , ("test5",test5)+     ]++main = do+    args <- getArgs+    main1 args++main1 ("--png":tests) = showTests tests renderToPNG+main1 ("--pdf":tests) = showTests tests renderToPDF+main1 ("--ps":tests) = showTests tests renderToPS+main1 tests = showTests tests renderToWindow++showTests tests outputfn = mapM_ outputfn (filter (match tests) allTests)++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 ++ ".png")+renderToPDF (n,t) = t PDF >>= \l -> renderableToPDFFile (toRenderable l) 640 480 (n ++ ".pdf")