packages feed

Chart 0.5 → 0.6

raw patch · 9 files changed

+576/−141 lines, 9 files

Files

Chart.cabal view
@@ -1,6 +1,6 @@ Name: Chart-Version: 0.5-License: BSD4+Version: 0.6+License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006 Author: Tim Docker <tim@dockerz.net>@@ -10,6 +10,7 @@ Description: A library for generating 2D Charts and Plots, based upon the cairo graphics library. Category: Graphics Cabal-Version: >= 1.2+Build-Type: Simple  Extra-Source-Files: tests/test.hs, tests/Prices.hs @@ -31,4 +32,5 @@         Graphics.Rendering.Chart.Axis,         Graphics.Rendering.Chart.Layout,         Graphics.Rendering.Chart.Plot+        Graphics.Rendering.Chart.Simple
Graphics/Rendering/Chart.hs view
@@ -4,7 +4,7 @@ -- Copyright   :  (c) Tim Docker 2006 -- License     :  BSD-style (see chart/COPYRIGHT) ----- A Simple framework for creating 2D charts in Haskell.+-- A 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@@ -14,6 +14,9 @@ -- Currently, the only useful 'Renderable' for displaying charts -- is created by applying 'toRenderable' to a value of type -- 'Graphics.Rendering.Chart.Layout.Layout1'+--+-- For a simpler though less flexible API, see "Graphics.Rendering.Chart.Simple".+-- -----------------------------------------------------------------------------  module Graphics.Rendering.Chart(@@ -38,6 +41,10 @@     defaultPlotFillBetween,     defaultLayout1,     filledCircles,+    hollowCircles,+    exes, plusses, stars,+    filledPolygon,+    hollowPolygon,     solidLine,     dashedLine,     solidFillStyle,
Graphics/Rendering/Chart/Axis.hs view
@@ -22,6 +22,10 @@     -- cordinates.     axis_viewport :: Range -> Double -> Double, +    -- | The title string to be displayed on the axis. An+    -- empty string means no title.+    axis_title :: String,+     -- | 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@@ -42,6 +46,7 @@     -- | How far the labels are to be drawn from the axis.     axis_label_gap :: Double, +    axis_title_style :: CairoFontStyle,     axis_line_style :: CairoLineStyle,     axis_label_style :: CairoFontStyle,     axis_grid_style :: CairoLineStyle@@ -153,8 +158,8 @@     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+renderAxisGrid :: Rect -> AxisT -> C.Render ()+renderAxisGrid rect@(Rect p1 p2) at@(AxisT re a) = do     C.save     setLineStyle (axis_grid_style a)     mapM_ (drawGridLine re) (axis_grid a)@@ -330,7 +335,7 @@ linkedAxes' af pts1 pts2 = (a,removeLabels a)   where     a  = af (pts1++pts2)-    removeLabels = liftM (\a -> a{axis_labels = []})+    removeLabels = liftM (\a -> a{axis_title="",axis_labels = []})  ---------------------------------------------------------------------- @@ -339,10 +344,12 @@  defaultAxis = Axis {     axis_viewport = vmap (0,1),+    axis_title = "",     axis_ticks = [(0,10),(1,10)],     axis_labels = [],     axis_grid = [0.0,0.5,1.0],-    axis_label_gap =10,+    axis_label_gap = 10,+    axis_title_style = defaultFontStyle,     axis_line_style = defaultAxisLineStyle,     axis_label_style = defaultFontStyle,     axis_grid_style = defaultGridLineStyle
Graphics/Rendering/Chart/Gtk.hs view
@@ -15,7 +15,8 @@  renderableToWindow :: Renderable -> Int -> Int -> IO () renderableToWindow chart windowWidth windowHeight = do-    G.initGUI+    G.unsafeInitGUIForThreadedRTS+    -- G.initGUI     window <- G.windowNew     canvas <- G.drawingAreaNew     -- fix size
Graphics/Rendering/Chart/Layout.hs view
@@ -12,6 +12,7 @@ import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Plot import Graphics.Rendering.Chart.Renderable+import Control.Monad  data HAxis = HA_Top | HA_Bottom deriving (Eq) data VAxis = VA_Left | VA_Right deriving (Eq)@@ -33,72 +34,72 @@     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) ] )-            ]-        )+   fillBackground (layout1_background l) (+       vertical [+       (0, addMargins (lm/2,0,0,0)    title),+       (1, addMargins (lm,lm,lm,lm) plotArea),+       (0, horizontal [ (0,mkLegend VA_Left),(1,emptyRenderable),(0, mkLegend VA_Right) ] )+       ]+     )   where     lm = layout1_margin l -    mkTitle l = label (layout1_title_style l) HTA_Centre VTA_Centre (layout1_title l)+    title = label (layout1_title_style l) HTA_Centre VTA_Centre (layout1_title l) -    mkLegend va l = case (layout1_legend l) of+    mkLegend va = 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)+    plotArea = grid [0,0,1,0,0] [0,0,1,0,0]+       [ [er,            er,        (1,atitle ta), er,        er       ],+         [er,            (1,tl),    (1,taxis),     (1,tr),    er       ],+         [(1,atitle la), (1,laxis), (0,plots),     (1,raxis), (1,atitle ra)],+         [er,            (1,bl),    (1,baxis),     (1,br),    er       ],+         [er,            er,        (1,atitle ba), er,        er       ] ] -renderPlotArea l (Rect p1 p5) = do-    let margin  = (layout1_margin l)+    atitle Nothing = emptyRenderable+    atitle (Just (AxisT e a)) = rlabel (axis_title_style a) ha va rot (axis_title a)+      where (ha,va,rot) = case e of E_Top -> (HTA_Centre,VTA_Bottom,0)+                                    E_Bottom -> (HTA_Centre,VTA_Top,0)+                                    E_Left -> (HTA_Right,VTA_Centre,90)+                                    E_Right -> (HTA_Left,VTA_Centre,90) -    (w1,h1,w2,h2) <- axisSizes l+    plots = Renderable {+        minsize=return (0,0),+        render=renderPlots l+    } -    let p2 = p1 `pvadd` (Vector w1 h1)-    let p4  = p5-    let p3  = p4 `pvsub` (Vector w2 h2)-    let plotRect = (Rect p2 p3)+    (ba,la,ta,ra) = getAxes l+    baxis = maybe emptyRenderable toRenderable ba+    taxis = maybe emptyRenderable toRenderable ta+    laxis = maybe emptyRenderable toRenderable la+    raxis = maybe emptyRenderable toRenderable ra +    tl = axesSpacer fst ta fst la+    bl = axesSpacer fst ba snd la+    tr = axesSpacer snd ta fst ra+    br = axesSpacer snd ba snd ra++    er = (0,emptyRenderable)++renderPlots l r@(Rect p1 p2) = do     -- render the plots     C.save-    setClipRegion p2 p3 -    mapM_ (rPlot plotRect) (layout1_plots l)+    setClipRegion p1 p2 +    mapM_ (rPlot r) (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)+    maybeM () (renderAxisGrid r) tAxis+    maybeM () (renderAxisGrid r) bAxis+    maybeM () (renderAxisGrid r) lAxis+    maybeM () (renderAxisGrid r) rAxis    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@@ -115,31 +116,12 @@ 	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+axesSpacer f1 a1 f2 a2 = embedRenderable $ do+    oh1 <- maybeM (0,0) axisOverhang a1+    oh2 <- maybeM (0,0) axisOverhang a2+    return (spacer (f1 oh1, f2 oh2)) +maybeM v = maybe (return v)  getAxes :: Layout1 -> (Maybe AxisT, Maybe AxisT, Maybe AxisT, Maybe AxisT) getAxes l = (mk E_Bottom bAxis, mk E_Left lAxis,
Graphics/Rendering/Chart/Renderable.hs view
@@ -8,6 +8,7 @@  import qualified Graphics.Rendering.Cairo as C import Control.Monad+import Data.List ( nub, partition, transpose, sort )  import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Plot@@ -29,8 +30,10 @@ class ToRenderable a where    toRenderable :: a -> Renderable -emptyRenderable = Renderable {-   minsize = return (0,0),+emptyRenderable = spacer (0,0)++spacer sz = Renderable {+   minsize = return sz,    render  = \_ -> return () } @@ -56,57 +59,48 @@ 	render r rect  vertical, horizontal :: [(Double,Renderable)] -> Renderable -vertical rs = Renderable { minsize = mf, render = rf }+vertical rs = grid [1] (map fst rs) [[(0,snd r)] | r <- rs]+horizontal rs = grid (map fst rs) [1] [[(0,snd r) | r <- rs]]++-- | Layout multiple Renderables into a grid.+-- Arg 1 is the weights for the allocation of extra horizontal space+-- to columns, Arg 2 is the weights for the allocation of extra+-- vertical space to rows, and Arg 3 is the grid of renderables to be+-- layed out. Each element of the grid is a tuple - the first item of+-- the tuple is the drawing priority.  Lower priorities get drawn+-- first. Drawing order is significant when Renderables draw outside+-- their edges.+grid :: [Double] -> [Double] -> [[(Int,Renderable)]] -> Renderable+grid we he rss = Renderable { minsize = mf, render = rf }   where     mf = do-        (_,wmin,hmin) <- calcSizes-	return (wmin, hmin)+      msizes <- getSizes+      let widths = (map.map) fst msizes+      let heights = (map.map) snd msizes+      return ((sum.map maximum.transpose) widths,(sum.map maximum) heights)      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'+      msizes <- getSizes+      let widths = (map maximum.(map.map) fst.transpose) msizes+      let heights = (map maximum.(map.map) snd) msizes+      let widths1 = allocate (p_x p2 - p_x p1 - sum widths) we widths+      let heights1 = allocate (p_y p2 - p_y p1 - sum heights) he heights+      let xs = scanl (+) (p_x p1) widths1+      let ys = scanl (+) (p_y p1) heights1+      +      forM_ priorities $ \pr->+        forM_ (zip3 rss ys (tail ys))  $ \(rs,y0,y1) ->+          forM_ (zip3 rs xs (tail xs))  $ \((n,r),x0,x1) ->+            when (n==pr) $ render r (Rect (Point x0 y0) (Point x1 y1)) -    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)+    getSizes = (mapM.mapM) (\(n,r)-> minsize r) rss+    priorities = sort (nub ((concatMap.map) fst rss)) -horizontal rs = Renderable { minsize = mf, render = rf }+allocate :: Double -> [Double] -> [Double] -> [Double]+allocate extra ws vs = zipWith (+) vs (extras++[0,0..])   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)+    total = sum ws +    extras = [ extra * v / total | v <- ws ]  renderableToPNGFile :: Renderable -> Int -> Int -> FilePath -> IO () renderableToPNGFile chart width height path = @@ -150,6 +144,13 @@     -- exactly one pixel      C.translate 0.5 0.5 +embedRenderable :: C.Render Renderable -> Renderable+embedRenderable ca = Renderable {+   minsize = do { a <- ca; minsize a },+   render = \ r -> do { a <- ca; render a r }+}++ ---------------------------------------------------------------------- -- Legend @@ -169,7 +170,7 @@  minsizeLegend :: Legend -> C.Render RectSize minsizeLegend (Legend _ ls plots) = do-    let labels = map fst plots+    let labels = nub $ map fst plots     lsizes <- mapM textSize labels     lgap <- legendSpacer     let lm = legend_margin ls@@ -181,20 +182,24 @@  renderLegend :: Legend -> Rect -> C.Render () renderLegend (Legend _ ls plots) (Rect rp1 rp2) = do-    foldM_ rf rp1 plots+    foldM_ rf rp1 $ join_nub plots   where     lm = legend_margin ls     lps = legend_plot_size ls -    rf :: Point -> (String,Plot) -> C.Render Point-    rf p1 (label,plot) = do+    rf :: Point -> (String,[Plot]) -> C.Render Point+    rf p1 (label,theseplots) = do         (w,h) <- textSize label 	lgap <- legendSpacer 	let p2 = (p1 `pvadd` Vector lps 0)-        plot_render_legend plot (mkrect p1 rp1 p2 rp2)+        mapM_ (\p -> plot_render_legend p (mkrect p1 rp1 p2 rp2)) theseplots 	let p3 = Point (p_x p2 + lgap) (p_y rp1) 	drawText HTA_Left VTA_Top p3 label         return (p3 `pvadd` Vector (w+lm) 0)+    join_nub :: [(String, a)] -> [(String, [a])]+    join_nub ((x,a1):ys) = case partition ((==x) . fst) ys of+                           (xs, rest) -> (x, a1:map snd xs) : join_nub rest+    join_nub [] = []  legendSpacer = do     (lgap,_) <- textSize "X"@@ -211,24 +216,57 @@ -- Labels  label :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> String -> Renderable-label fs hta vta s = Renderable { minsize = mf, render = rf }+label fs hta vta = rlabel fs hta vta 0++rlabel :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> Double -> String -> Renderable+rlabel fs hta vta rot s = Renderable { minsize = mf, render = rf }   where     mf = do        C.save        setFontStyle fs-       sz <- textSize s+       (w,h) <- textSize s        C.restore-       return sz+       let sz' = (w*acr+h*asr,w*asr+h*acr)+       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+       sz@(w,h) <- textSize s+       C.translate (xadj sz hta (p_x p1) (p_x p2)) (yadj sz vta (p_y p1) (p_y p2))+       C.rotate rot'+       C.moveTo (-w/2) (h/2)+       C.showText 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+    xadj (w,h) HTA_Left x1 x2 =  x1 +(w*acr+h*asr)/2+    xadj (w,h) HTA_Centre x1 x2 = (x1 + x2)/2+    xadj (w,h) HTA_Right x1 x2 =  x2 -(w*acr+h*asr)/2+    yadj (w,h) VTA_Top y1 y2 =  y1 +(w*asr+h*acr)/2+    yadj (w,h) VTA_Centre y1 y2 = (y1+y2)/2+    yadj (w,h) VTA_Bottom y1 y2 =  y2 - (w*asr+h*acr)/2 +    rot' = rot / 180 * pi+    (cr,sr) = (cos rot', sin rot')+    (acr,asr) = (abs cr, abs sr)++-- a quick test to display labels with all combinations+-- of anchors+labelTest rot = renderableToPNGFile r 800 800 "labels.png"+  where+    r = fillBackground white $ grid [1,1,1] [1,1,1] ls+    ls = [ [(0,addMargins (20,20,20,20) $ fillBackground blue $ crossHairs $ rlabel fs h v rot s) | h <- hs] | v <- vs ]+    s = "Labels"+    hs = [HTA_Left, HTA_Centre, HTA_Right]+    vs = [VTA_Top, VTA_Centre, VTA_Bottom]+    white = solidFillStyle 1 1 1+    blue = solidFillStyle 0.8 0.8 1+    fs = fontStyle "sans" 30 C.FontSlantNormal C.FontWeightBold+    crossHairs r =Renderable {+      minsize = minsize r,+      render = \rect@(Rect (Point x1 y1) (Point x2 y2)) -> do+          let xa = (x1 + x2) / 2+          let ya = (y1 + y2) / 2+          strokeLines [Point x1 ya,Point x2 ya]+          strokeLines [Point xa y1,Point xa y2]+          render r rect+    }+
+ Graphics/Rendering/Chart/Simple.hs view
@@ -0,0 +1,265 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.Rendering.Chart.Simple+-- Copyright   :  (c) David Roundy 2007+-- License     :  BSD-style (see chart/COPYRIGHT)+--+-- An even simpler framework for creating 2D charts in Haskell.+--+-- The basic idea is to make it as easy to plot as octave, which means that+-- you provide no more information than you wish to provide.  We provide+-- four plotting functions, which differ only in their output.  One+-- produces a "Layout1" that you can customize using other+-- Graphics.Rendering.Chart functions.  The other three produce their+-- output directly.  All three accept the same input (except for the+-- filename required by plotPDF and plotPS), and produce the same plots.+--+-- The plot functions accept a variable number of arguments.  You must+-- provide a [Double] which defines the points on the x axis, which must+-- precede any of the "y" values.  The y values may either be [Double] or+-- functions.  After any given y value, you can give either Strings or+-- PlotKinds describing how you'd like that y printed.+--+-- Examples:+--+-- 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"+--+-- plotPDF "foo.pdf" [0,0.1..10] sin "- " cos ". " cos "o"+--+-- plotPS "foo.ps" [0,0.1..10] (sin.exp) "- " (sin.exp) "o-"+-----------------------------------------------------------------------------+module Graphics.Rendering.Chart.Simple( plot, PlotKind(..), xcoords,+                                        plotWindow, plotPDF, plotPS+                                      ) where++import Data.Maybe ( catMaybes )++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Gtk++styleColor :: (Double -> Double -> Double -> a) -> Int -> a+styleColor f ind = case colorSequence !! ind of (r,g,b) -> f r g b+    where colorSequence = cycle [(0,0,1),(1,0,0),(0,1,0),(1,1,0),(0,1,1),(1,0,1),(0,0,0)]++styleSymbol :: Int -> PlotKind+styleSymbol ind = symbolSequence !! ind+    where symbolSequence = cycle [ Ex, HollowCircle, Triangle, DownTriangle, Square,+                                   Diamond, Plus, Star, FilledCircle ]++iplot :: [InternalPlot] -> Layout1+iplot foobar = defaultLayout1 {+        layout1_plots = concat $ zipWith toplot (ip foobar) [0..]+    }+    where ip (xs@(IPX _ _):xyss) = map (\ys -> (xs,ys)) yss ++ ip rest+              where yss = takeWhile isIPY xyss+                    rest = dropWhile isIPY xyss+          ip (_:xyss) = ip xyss+          ip [] = []+          isIPY (IPY _ _) = True+          isIPY _ = False+          toplot (IPX xs _, IPY ys yks) ind = map (\z -> (name yks, HA_Bottom, VA_Left, z)) plots+              where vs = map (\(x,y) -> Point x y) $ filter isOkay $ zip xs ys+                    plots = case catMaybes $ map plotas yks of+                            [] -> [toPlot $ defaultPlotLines+                                   { plot_lines_values = [vs],+                                     plot_lines_style = solidLine 1 `styleColor` ind }]+                            xs -> xs+                    plotas Solid = Just $ toPlot $ defaultPlotLines+                                   { plot_lines_values = [vs],+                                     plot_lines_style = solidLine 1 `styleColor` ind }+                    plotas Dashed = Just $ toPlot $ defaultPlotLines+                                   { plot_lines_values = [vs],+                                     plot_lines_style = dashedLine 1 [10,10] `styleColor` ind }+                    plotas Dotted = Just $ toPlot $ defaultPlotLines+                                   { plot_lines_values = [vs],+                                     plot_lines_style = dashedLine 1 [1,11] `styleColor` ind }+                    plotas FilledCircle = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=filledCircles 4 `styleColor` ind }+                    plotas HollowCircle = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=hollowCircles 5 1 `styleColor` ind }+                    plotas Triangle = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=hollowPolygon 7 1 3 False `styleColor` ind }+                    plotas DownTriangle = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=hollowPolygon 7 1 3 True `styleColor` ind }+                    plotas Square = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=hollowPolygon 7 1 4 False `styleColor` ind }+                    plotas Diamond = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=hollowPolygon 7 1 4 True `styleColor` ind }+                    plotas Plus = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=plusses 7 1 `styleColor` ind }+                    plotas Ex = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=exes 7 1 `styleColor` ind }+                    plotas Star = Just $ toPlot $ defaultPlotPoints+                                          { plot_points_values = vs,+                                            plot_points_style=stars 7 1 `styleColor` ind }+                    plotas Symbols = plotas (styleSymbol ind)+                    plotas _ = Nothing+          isOkay (_,n) = not (isNaN n || isInfinite n)++name :: [PlotKind] -> String+name (Name s:_) = s+name (_:ks) = name ks+name [] = ""++str2k :: String -> [PlotKind]+str2k "" = []+str2k ". " = [Dotted]+str2k s@('?':_) = str2khelper s Symbols+str2k s@('@':_) = str2khelper s FilledCircle+str2k s@('#':_) = str2khelper s Square+str2k s@('v':_) = str2khelper s DownTriangle+str2k s@('^':_) = str2khelper s Triangle+str2k s@('o':_) = str2khelper s HollowCircle+str2k s@('+':_) = str2khelper s Plus+str2k s@('x':_) = str2khelper s Ex+str2k s@('*':_) = str2khelper s Star+str2k s@('.':_) = str2khelper s LittleDot+str2k "- " = [Dashed]+str2k "-" = [Solid]+str2k n = [Name n]++str2khelper :: String -> PlotKind -> [PlotKind]+str2khelper s@(_:r) x = case str2k r of+                        [] -> [x]+                        [Name _] -> [Name s]+                        xs -> x:xs++-- | Type to define a few simple properties of each plot.+data PlotKind = Name String | FilledCircle | HollowCircle+              | Triangle | DownTriangle | Square | Diamond | Plus | Ex | Star | Symbols+              | LittleDot | Dashed | Dotted | Solid+              deriving ( Eq, Show, Ord )+data InternalPlot = IPY [Double] [PlotKind] | IPX [Double] [PlotKind]++uplot :: [UPlot] -> Layout1+uplot us = iplot $ nameDoubles $ evalfuncs us+    where nameDoubles :: [UPlot] -> [InternalPlot]+          nameDoubles (X xs:uus) = case grabName uus of+                                     (ks,uus') -> IPX xs ks : nameDoubles uus'+          nameDoubles (UDoubles xs:uus) = case grabName uus of+                                          (ks,uus') -> IPY xs ks : nameDoubles uus'+          nameDoubles (_:uus) = nameDoubles uus+          nameDoubles [] = []+          evalfuncs :: [UPlot] -> [UPlot]+          evalfuncs (UDoubles xs:uus) = X xs : map ef (takeWhile (not.isX) uus)+                                        ++ evalfuncs (dropWhile (not.isX) uus)+              where ef (UFunction f) = UDoubles (map f xs)+                    ef u = u+          evalfuncs (X xs:uus) = X xs : map ef (takeWhile (not.isX) uus)+                                 ++ evalfuncs (dropWhile (not.isX) uus)+              where ef (UFunction f) = UDoubles (map f xs)+                    ef u = u+          evalfuncs (u:uus) = u : evalfuncs uus+          evalfuncs [] = []+          grabName :: [UPlot] -> ([PlotKind],[UPlot])+          grabName (UString n:uus) = case grabName uus of+                                     (ks,uus') -> (str2k n++ks,uus')+          grabName (UKind ks:uus) = case grabName uus of+                                     (ks',uus') -> (ks++ks',uus')+          grabName uus = ([],uus)+          isX (X _) = True+          isX _ = False++-- | The main plotting function.  The idea behind PlotType is shamelessly+-- copied from Text.Printf (and is not exported).  All you need to know is+-- that your arguments need to be in class PlotArg.  And PlotArg consists+-- of functions and [Double] and String and PlotKind or [PlotKind].++plot :: PlotType a => a+plot = pl []+class PlotType t where+    pl :: [UPlot] -> t+instance (PlotArg a, PlotType r) => PlotType (a -> r) where+    pl args = \ a -> pl (toUPlot a ++ args)+instance PlotType Layout1 where+    pl args = uplot (reverse args)++-- | Display a plot on the screen.++plotWindow :: PlotWindowType a => a+plotWindow = plw []+class PlotWindowType t where+    plw :: [UPlot] -> t+instance (PlotArg a, PlotWindowType r) => PlotWindowType (a -> r) where+    plw args = \ a -> plw (toUPlot a ++ args)+instance PlotWindowType (IO a) where+    plw args = do renderableToWindow (toRenderable $ uplot (reverse args)) 640 480+                  return undefined++-- | Save a plot as a PDF file.++plotPDF :: PlotPDFType a => String -> a+plotPDF fn = pld fn []+class PlotPDFType t where+    pld :: FilePath -> [UPlot] -> t+instance (PlotArg a, PlotPDFType r) => PlotPDFType (a -> r) where+    pld fn args = \ a -> pld fn (toUPlot a ++ args)+instance PlotPDFType (IO a) where+    pld fn args = do renderableToPDFFile (toRenderable $ uplot (reverse args)) 640 480 fn+                     return undefined++-- | Save a plot as a postscript file.++plotPS :: PlotPSType a => String -> a+plotPS fn = pls fn []+class PlotPSType t where+    pls :: FilePath -> [UPlot] -> t+instance (PlotArg a, PlotPSType r) => PlotPSType (a -> r) where+    pls fn args = \ a -> pls fn (toUPlot a ++ args)+instance PlotPSType (IO a) where+    pls fn args = do renderableToPSFile (toRenderable $ uplot (reverse args)) 640 480 fn+                     return undefined++data UPlot = UString String | UDoubles [Double] | UFunction (Double -> Double)+           | UKind [PlotKind] | X [Double]++xcoords :: [Double] -> UPlot+xcoords = X++class PlotArg a where+    toUPlot :: a -> [UPlot]++instance IsPlot p => PlotArg [p] where+    toUPlot = toUPlot'++instance (Real a, Real b, Fractional a, Fractional b) => PlotArg (a -> b) where+    toUPlot f = [UFunction (realToFrac . f . realToFrac)]++instance PlotArg UPlot where+    toUPlot = (:[])++instance PlotArg PlotKind where+    toUPlot = (:[]) . UKind . (:[])++class IsPlot c where+    toUPlot' :: [c] -> [UPlot]++instance IsPlot PlotKind where+    toUPlot' = (:[]) . UKind++instance IsPlot Double where+    toUPlot' = (:[]) . UDoubles++instance IsPlot Char where+    toUPlot' = (:[]) . UString++instance IsPlot p => IsPlot [p] where+    toUPlot' = reverse . concatMap toUPlot'++instance (IsPlot p, IsPlot q, IsPlot r) => IsPlot (p,q,r) where+    toUPlot' = reverse . concatMap f+        where f (p,q,r) = toUPlot' [p] ++ toUPlot' [q] ++ toUPlot' [r]++instance (IsPlot p, IsPlot q) => IsPlot (p,q) where+    toUPlot' = reverse . concatMap f+        where f (p,q) = toUPlot' [p] ++ toUPlot' [q]
Graphics/Rendering/Chart/Types.hs view
@@ -160,6 +160,123 @@ 	C.arc x y radius 0 360 	C.fill +hollowCircles ::+     Double -- ^ radius of circle+  -> Double -- ^ thickness of line+  -> Double -- ^ red component of colour+  -> Double -- ^ green component of colour+  -> Double -- ^ blue component of colour+  -> CairoPointStyle+hollowCircles radius w r g b = CairoPointStyle rf+  where+    rf (Point x y) = do+        C.setLineWidth w+	C.setSourceRGB r g b+        C.newPath+	C.arc x y radius 0 360+	C.stroke++hollowPolygon ::+     Double -- ^ radius of circle+  -> Double -- ^ thickness of line+  -> Int    -- ^ Number of vertices+  -> Bool   -- ^ Is right-side-up?+  -> Double -- ^ red component of colour+  -> Double -- ^ green component of colour+  -> Double -- ^ blue component of colour+  -> CairoPointStyle+hollowPolygon radius w sides isrot r g b = CairoPointStyle rf+  where rf (Point x y) =+            do C.setLineWidth w+	       C.setSourceRGB r g b+               C.newPath+               let intToAngle n = if isrot+                                  then fromIntegral n * 2*pi / fromIntegral sides+                                  else (0.5 + fromIntegral n)*2*pi/fromIntegral sides+                   angles = map intToAngle [0 .. sides-1]+                   (p:ps) = map (\a -> Point (x + radius * sin a) (y + radius * cos a)) angles+               moveTo p+               mapM_ lineTo (ps++[p])+	       C.stroke++filledPolygon ::+     Double -- ^ radius of circle+  -> Int    -- ^ Number of vertices+  -> Bool   -- ^ Is right-side-up?+  -> Double -- ^ red component of colour+  -> Double -- ^ green component of colour+  -> Double -- ^ blue component of colour+  -> CairoPointStyle+filledPolygon radius sides isrot r g b = CairoPointStyle rf+  where rf (Point x y) =+            do C.setSourceRGB r g b+               C.newPath+               let intToAngle n = if isrot+                                  then fromIntegral n * 2*pi / fromIntegral sides+                                  else (0.5 + fromIntegral n)*2*pi/fromIntegral sides+                   angles = map intToAngle [0 .. sides-1]+                   (p:ps) = map (\a -> Point (x + radius * sin a) (y + radius * cos a)) angles+               moveTo p+               mapM_ lineTo (ps++[p])+	       C.fill++plusses ::+     Double -- ^ radius of circle+  -> Double -- ^ thickness of line+  -> Double -- ^ red component of colour+  -> Double -- ^ green component of colour+  -> Double -- ^ blue component of colour+  -> CairoPointStyle+plusses radius w r g b = CairoPointStyle rf+  where rf (Point x y) = do C.setLineWidth w+	                    C.setSourceRGB r g b+                            C.newPath+                            C.moveTo (x+radius) y+                            C.lineTo (x-radius) y+                            C.moveTo x (y-radius)+                            C.lineTo x (y+radius)+	                    C.stroke++exes ::+     Double -- ^ radius of circle+  -> Double -- ^ thickness of line+  -> Double -- ^ red component of colour+  -> Double -- ^ green component of colour+  -> Double -- ^ blue component of colour+  -> CairoPointStyle+exes radius w r g b = CairoPointStyle rf+  where rad = radius / sqrt 2+        rf (Point x y) = do C.setLineWidth w+	                    C.setSourceRGB r g b+                            C.newPath+                            C.moveTo (x+rad) (y+rad)+                            C.lineTo (x-rad) (y-rad)+                            C.moveTo (x+rad) (y-rad)+                            C.lineTo (x-rad) (y+rad)+	                    C.stroke++stars ::+     Double -- ^ radius of circle+  -> Double -- ^ thickness of line+  -> Double -- ^ red component of colour+  -> Double -- ^ green component of colour+  -> Double -- ^ blue component of colour+  -> CairoPointStyle+stars radius w r g b = CairoPointStyle rf+  where rad = radius / sqrt 2+        rf (Point x y) = do C.setLineWidth w+	                    C.setSourceRGB r g b+                            C.newPath+                            C.moveTo (x+radius) y+                            C.lineTo (x-radius) y+                            C.moveTo x (y-radius)+                            C.lineTo x (y+radius)+                            C.moveTo (x+rad) (y+rad)+                            C.lineTo (x-rad) (y-rad)+                            C.moveTo (x+rad) (y-rad)+                            C.lineTo (x-rad) (y+rad)+	                    C.stroke+ solidLine ::      Double -- ^ width of line   -> Double -- ^ red component of colour
tests/test.hs view
@@ -1,5 +1,6 @@ import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Simple import Graphics.Rendering.Chart.Gtk import System.Environment(getArgs) import System.Time@@ -124,8 +125,8 @@      layout = defaultLayout1 {         layout1_title="Log/Linear Example",			   -        layout1_horizontal_axes=linkedAxes (autoScaledAxis defaultAxis),-	layout1_vertical_axes=linkedAxes (autoScaledLogAxis defaultAxis),+        layout1_horizontal_axes=linkedAxes' (autoScaledAxis defaultAxis{axis_title="horizontal"}),+	layout1_vertical_axes=linkedAxes' (autoScaledLogAxis defaultAxis{axis_title="vertical"}), 	layout1_plots = [("values",HA_Bottom,VA_Left,(toPlot points)), 			 ("values",HA_Bottom,VA_Left,(toPlot lines)) ]     }@@ -167,13 +168,28 @@      lineWidth = chooseLineWidth otype + ----------------------------------------------------------------------        +-- Test the Simple interface++test6 :: OutputType -> IO Layout1+test6 otype = return pp{layout1_title="Graphics.Rendering.Chart.Simple example"}+  where+    pp = plot xs sin "sin"+                 cos "cos" "o"+                 (sin.sin.cos) "sin.sin.cos" "."+                 (/3) "- "+                 (const 0.5)+                 [0.1,0.7,0.5::Double] "+"+    xs = [0,0.3..3] :: [Double]+----------------------------------------------------------------------         allTests =      [ ("test1",test1)      , ("test2",test2)      , ("test3",test3)      , ("test4",test4)      , ("test5",test5)+     , ("test6",test6)      ]  main = do@@ -192,5 +208,5 @@  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")+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")