Chart-0.16/0000755000000000000000000000000012006610042010656 5ustar0000000000000000Chart-0.16/Setup.hs0000644000000000000000000000014712006610042012314 0ustar0000000000000000#!/usr/bin/env runghc module Main where import Distribution.Simple main :: IO () main = defaultMain Chart-0.16/Chart.cabal0000644000000000000000000000464512006610042012714 0ustar0000000000000000Name: Chart Version: 0.16 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2010 Author: Tim Docker Maintainer: Tim Docker 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.6 Build-Type: Simple Extra-Source-Files: tests/all_tests.hs, tests/Test1.hs, tests/Test2.hs, tests/Test3.hs, tests/Test4.hs, tests/Test5.hs, tests/Test6.hs, tests/Test7.hs, tests/Test8.hs, tests/Test9.hs, tests/Test14.hs, tests/Test14a.hs, tests/Test15.hs, tests/Test17.hs, tests/TestParametric.hs, tests/Prices.hs tests/ExampleStocks.hs flag splitbase description: Choose the new smaller, split-up base package. library if flag(splitbase) Build-depends: base >= 3 && < 5, old-locale, time, mtl, array else Build-depends: base < 3 Build-depends: cairo >= 0.9.11, time, mtl, array, data-accessor == 0.2.*, data-accessor-template >= 0.2.1.1 && < 0.3, colour >= 2.2.1 Exposed-modules: Graphics.Rendering.Chart, Graphics.Rendering.Chart.Types, Graphics.Rendering.Chart.Renderable, Graphics.Rendering.Chart.Axis, Graphics.Rendering.Chart.Axis.Floating, Graphics.Rendering.Chart.Axis.Indexed, Graphics.Rendering.Chart.Axis.Int, Graphics.Rendering.Chart.Axis.LocalTime, Graphics.Rendering.Chart.Axis.Types, Graphics.Rendering.Chart.Axis.Unit, Graphics.Rendering.Chart.Layout, Graphics.Rendering.Chart.Legend, Graphics.Rendering.Chart.Simple, Graphics.Rendering.Chart.Simple.Internal, Graphics.Rendering.Chart.Grid, Graphics.Rendering.Chart.Plot, Graphics.Rendering.Chart.Plot.Types, Graphics.Rendering.Chart.Plot.Annotation, Graphics.Rendering.Chart.Plot.AreaSpots, Graphics.Rendering.Chart.Plot.Bars, Graphics.Rendering.Chart.Plot.Candle, Graphics.Rendering.Chart.Plot.ErrBars, Graphics.Rendering.Chart.Plot.FillBetween, Graphics.Rendering.Chart.Plot.Hidden, Graphics.Rendering.Chart.Plot.Lines, Graphics.Rendering.Chart.Plot.Pie, Graphics.Rendering.Chart.Plot.Points Graphics.Rendering.Chart.SparkLine Chart-0.16/LICENSE0000644000000000000000000000271212006610042011665 0ustar0000000000000000Copyright (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. Chart-0.16/Graphics/0000755000000000000000000000000012006610042012416 5ustar0000000000000000Chart-0.16/Graphics/Rendering/0000755000000000000000000000000012006610042014333 5ustar0000000000000000Chart-0.16/Graphics/Rendering/Chart.hs0000644000000000000000000000353512006610042015736 0ustar0000000000000000---------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- 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 -- 'Renderable' is then actually displayed or output by calling either -- 'renderableToPNGFile', or 'renderableToWindow'. -- -- Currently, there are two kinds of 'Renderable' for displaying charts: -- -- * a standard two axes chart can be is created by applying -- 'toRenderable' to a value of type 'Layout1' -- -- * a pie chart can be is created by applying -- 'toRenderable' to a value of type 'PieLayout' -- -- Multiple Renderables can be composed using the "Graphics.Rendering.Chart.Grid" module. -- -- Many of the record structure involved in the API have a large -- number of fields. For each record type X, there is generally a -- default value called defaultX with sensibly initialised fields. -- For example, 'Layout1' has 'defaultLayout1', etc. -- -- For a simpler though less flexible API, see "Graphics.Rendering.Chart.Simple". -- ----------------------------------------------------------------------------- module Graphics.Rendering.Chart( module Graphics.Rendering.Chart.Types, module Graphics.Rendering.Chart.Renderable, module Graphics.Rendering.Chart.Layout, module Graphics.Rendering.Chart.Axis, module Graphics.Rendering.Chart.Plot, module Graphics.Rendering.Chart.Legend, ) 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 import Graphics.Rendering.Chart.Legend Chart-0.16/Graphics/Rendering/Chart/0000755000000000000000000000000012006610042015374 5ustar0000000000000000Chart-0.16/Graphics/Rendering/Chart/Legend.hs0000644000000000000000000000662012006610042017132 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Legend -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Types and functions for handling the legend(s) on a chart. A legend -- is an area on the chart used to label the plotted values. {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Legend( Legend(..), LegendStyle(..), LegendOrientation(..), defaultLegendStyle, legendToRenderable, legend_label_style, legend_margin, legend_plot_size, legend_orientation ) where import qualified Graphics.Rendering.Cairo as C import Control.Monad import Data.List (nub, partition,intersperse) import Data.Accessor.Template import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Plot.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Grid ---------------------------------------------------------------------- -- Legend data LegendStyle = LegendStyle { legend_label_style_ :: CairoFontStyle, legend_margin_ :: Double, legend_plot_size_ :: Double, legend_orientation_ :: LegendOrientation } -- | Legends can be constructed in two orientations: in rows -- (where we specify the maximum number of columns), and in -- columns (where we specify the maximum number of rows) data LegendOrientation = LORows Int | LOCols Int data Legend x y = Legend LegendStyle [(String, Rect -> CRender ())] instance ToRenderable (Legend x y) where toRenderable = setPickFn nullPickFn.legendToRenderable legendToRenderable :: Legend x y -> Renderable String legendToRenderable (Legend ls lvs) = gridToRenderable grid where grid = case legend_orientation_ ls of LORows n -> mkGrid n aboveG besideG LOCols n -> mkGrid n besideG aboveG aboveG = aboveN.(intersperse ggap1) besideG = besideN.(intersperse ggap1) mkGrid n join1 join2 = join1 [ join2 (map rf ps1) | ps1 <- groups n ps ] ps :: [(String, [Rect -> CRender ()])] ps = join_nub lvs rf (title,rfs) = besideN [gpic,ggap2,gtitle] where gpic = besideN $ intersperse ggap2 (map rp rfs) gtitle = tval $ lbl title rp rfn = tval $ Renderable { minsize = return (legend_plot_size_ ls, 0), render = \(w,h) -> do rfn (Rect (Point 0 0) (Point w h)) return (\_-> Just title) } ggap1 = tval $ spacer (legend_margin_ ls,legend_margin_ ls / 2) ggap2 = tval $ spacer1 (lbl "X") lbl s = label (legend_label_style_ ls) HTA_Left VTA_Centre s groups :: Int -> [a] -> [[a]] groups n [] = [] groups n vs = let (vs1,vs2) = splitAt n vs in vs1:groups n vs2 join_nub :: [(String, a)] -> [(String, [a])] join_nub ((x,a1):ys) = case partition ((==x) . fst) ys of (xs, rest) -> (x, a1:map snd xs) : join_nub rest join_nub [] = [] defaultLegendStyle :: LegendStyle defaultLegendStyle = LegendStyle { legend_label_style_ = defaultFontStyle, legend_margin_ = 20, legend_plot_size_ = 20, legend_orientation_ = LORows 4 } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''LegendStyle ) Chart-0.16/Graphics/Rendering/Chart/Axis.hs0000644000000000000000000000167012006610042016640 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Code to calculate and render axes. -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Axis( module Graphics.Rendering.Chart.Axis.Types, module Graphics.Rendering.Chart.Axis.Floating, module Graphics.Rendering.Chart.Axis.Int, module Graphics.Rendering.Chart.Axis.LocalTime, module Graphics.Rendering.Chart.Axis.Unit, module Graphics.Rendering.Chart.Axis.Indexed, ) where import Graphics.Rendering.Chart.Axis.Types import Graphics.Rendering.Chart.Axis.Floating import Graphics.Rendering.Chart.Axis.Int import Graphics.Rendering.Chart.Axis.LocalTime import Graphics.Rendering.Chart.Axis.Unit import Graphics.Rendering.Chart.Axis.Indexed Chart-0.16/Graphics/Rendering/Chart/Layout.hs0000644000000000000000000004034312006610042017211 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Layout -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- This module glues together axes and plots to actually create a renderable -- for a chart. -- -- Note that template haskell is used to derive accessor functions -- (see 'Data.Accessor') for each field of the following data types: -- -- * 'Layout1' -- -- * 'LayoutAxis' -- -- These accessors are not shown in this API documentation. They have -- the same name as the field, but with the trailing underscore -- dropped. Hence for data field f_::F in type D, they have type -- -- @ -- f :: Data.Accessor.Accessor D F -- @ -- {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Layout( Layout1(..), LayoutAxis(..), Layout1Pick(..), MAxisFn, defaultLayout1, layout1ToRenderable, linkAxes, independentAxes, updateAllAxesStyles, setLayout1Foreground, defaultLayoutAxis, laxis_title_style, laxis_title, laxis_style, laxis_visible, laxis_generate, laxis_override, laxis_reverse, layout1_background, layout1_plot_background, layout1_title, layout1_title_style, layout1_left_axis, layout1_right_axis, layout1_top_axis, layout1_bottom_axis, layout1_yaxes_control, layout1_margin, layout1_plots, layout1_legend, layout1_grid_last, renderLayout1sStacked, AnyLayout1(), withAnyOrdinate ) 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.Legend import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Grid import Control.Monad import Control.Monad.Reader (local) import Data.Accessor.Template import Data.Accessor import Data.Colour import Data.Colour.Names (white) -- | A @MAxisFn@ is a function that generates an (optional) axis -- given the points plotted against that axis. type MAxisFn t = [t] -> Maybe (AxisData t) data LayoutAxis x = LayoutAxis { laxis_title_style_ :: CairoFontStyle, laxis_title_ :: String, laxis_style_ :: AxisStyle, -- | Function that determines whether an axis should be visible, -- based upon the points plotted on this axis. The default value -- is 'not.null'. laxis_visible_ :: [x] -> Bool, -- | Function that generates the axis data, based upon the -- points plotted. The default value is 'autoAxis'. laxis_generate_ :: AxisFn x, -- | Function that can be used to override the generated axis data. -- The default value is 'id'. laxis_override_ :: AxisData x -> AxisData x, -- | True if left to right (bottom to top) is to show descending values. laxis_reverse_ :: Bool } -- | 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. It's -- parameterised by the types of values to be plotted on the horizonal -- and vertical axes. data Layout1 x y = Layout1 { layout1_background_ :: CairoFillStyle, layout1_plot_background_ :: Maybe CairoFillStyle, layout1_title_ :: String, layout1_title_style_ :: CairoFontStyle, layout1_bottom_axis_ :: LayoutAxis x, layout1_top_axis_ :: LayoutAxis x, layout1_left_axis_ :: LayoutAxis y, layout1_right_axis_ :: LayoutAxis y, -- | Function to map points from the left/right plot -- to the left/right axes. The default value is 'id'. layout1_yaxes_control_ :: ([y],[y]) -> ([y],[y]), layout1_margin_ :: Double, layout1_plots_ :: [Either (Plot x y) (Plot x y)], layout1_legend_ :: Maybe LegendStyle, -- | True if the grid is to be rendered on top of the Plots. layout1_grid_last_ :: Bool } data Layout1Pick x y = L1P_Legend String | L1P_Title String | L1P_BottomAxisTitle String | L1P_TopAxisTitle String | L1P_LeftAxisTitle String | L1P_RightAxisTitle String | L1P_PlotArea x y y | L1P_BottomAxis x | L1P_TopAxis x | L1P_LeftAxis y | L1P_RightAxis y deriving (Show) instance (Ord x, Ord y) => ToRenderable (Layout1 x y) where toRenderable = setPickFn nullPickFn.layout1ToRenderable -- | Encapsulates a 'Layout1' with a fixed abscissa type but -- arbitrary ordinate type. data AnyLayout1 x = AnyLayout1 { background :: CairoFillStyle, titleRenderable :: Renderable (), plotAreaGrid :: Grid (Renderable ()), legendRenderable :: Renderable (), margin :: Double } withAnyOrdinate :: (Ord x,Ord y) => Layout1 x y -> AnyLayout1 x withAnyOrdinate l = AnyLayout1 { background = layout1_background_ l, titleRenderable = mapPickFn (const ()) $ layout1TitleToRenderable l, plotAreaGrid = fmap (mapPickFn (const ())) $ layout1PlotAreaToGrid l, legendRenderable = mapPickFn (const ()) $ layout1LegendsToRenderable l, margin = layout1_margin_ l } -- | Render several layouts with the same abscissa type stacked so that their -- origins and axis titles are aligned horizontally with respect to each -- other. The exterior margins and background are taken from the first -- element. renderLayout1sStacked :: (Ord x) => [AnyLayout1 x] -> Renderable () renderLayout1sStacked [] = emptyRenderable renderLayout1sStacked ls@(l1:_) = gridToRenderable g where g = fullOverlayUnder (fillBackground (background l1) emptyRenderable) $ addMarginsToGrid (lm,lm,lm,lm) $ aboveN [ fullRowAbove (titleRenderable l) 0 ( fullRowBelow (legendRenderable l) 0 (plotAreaGrid l)) | l <- ls ] lm = margin l1 addMarginsToGrid :: (Double,Double,Double,Double) -> Grid (Renderable a) -> Grid (Renderable a) addMarginsToGrid (t,b,l,r) g = aboveN [ besideN [er, ts, er], besideN [ls, g, rs], besideN [er, bs, er] ] where er = empty ts = tval $ spacer (0,t) ls = tval $ spacer (l,0) bs = tval $ spacer (0,b) rs = tval $ spacer (r,0) layout1ToRenderable :: (Ord x, Ord y) => Layout1 x y -> Renderable (Layout1Pick x y) layout1ToRenderable l = fillBackground (layout1_background_ l) $ gridToRenderable (layout1ToGrid l) layout1ToGrid :: (Ord x, Ord y) => Layout1 x y -> Grid (Renderable (Layout1Pick x y)) layout1ToGrid l = aboveN [ tval $ layout1TitleToRenderable l , weights (1,1) $ tval $ gridToRenderable $ addMarginsToGrid (lm,lm,lm,lm) (layout1PlotAreaToGrid l) , tval $ layout1LegendsToRenderable l ] where lm = layout1_margin_ l layout1TitleToRenderable :: (Ord x, Ord y) => Layout1 x y -> Renderable (Layout1Pick x y) layout1TitleToRenderable l | null (layout1_title_ l) = emptyRenderable layout1TitleToRenderable l = addMargins (lm/2,0,0,0) (mapPickFn L1P_Title title) where title = label (layout1_title_style_ l) HTA_Centre VTA_Centre (layout1_title_ l) lm = layout1_margin_ l layout1LegendsToRenderable :: (Ord x, Ord y) => Layout1 x y -> Renderable (Layout1Pick x y) layout1LegendsToRenderable l = gridToRenderable g where g = besideN [ tval $ mkLegend lefts , weights (1,1) $ tval $ emptyRenderable , tval $ mkLegend rights ] lefts = concat [ plot_legend_ p | (Left p ) <- (layout1_plots_ l) ] rights = concat [ plot_legend_ p | (Right p) <- (layout1_plots_ l) ] lm = layout1_margin_ l mkLegend vals = case (layout1_legend_ l) of Nothing -> emptyRenderable Just ls -> case filter ((/="").fst) vals of [] -> emptyRenderable ; lvs -> addMargins (0,lm,lm,lm) $ mapPickFn L1P_Legend $ legendToRenderable (Legend ls lvs) layout1PlotAreaToGrid :: (Ord x, Ord y) => Layout1 x y -> Grid (Renderable (Layout1Pick x y)) layout1PlotAreaToGrid l = layer2 `overlay` layer1 where layer1 = aboveN [ besideN [er, er, er ] , besideN [er, er, er ] , besideN [er, er, weights (1,1) plots ] ] layer2 = aboveN [ besideN [er, er, ttitle, er, er ] , besideN [er, tl, taxis, tr, er ] , besideN [ltitle, laxis, er, raxis, rtitle ] , besideN [er, bl, baxis, br, er ] , besideN [er, er, btitle, er, er ] ] ttitle = atitle HTA_Centre VTA_Bottom 0 layout1_top_axis_ L1P_TopAxisTitle btitle = atitle HTA_Centre VTA_Top 0 layout1_bottom_axis_ L1P_BottomAxisTitle ltitle = atitle HTA_Right VTA_Centre 270 layout1_left_axis_ L1P_LeftAxisTitle rtitle = atitle HTA_Left VTA_Centre 270 layout1_right_axis_ L1P_RightAxisTitle er = tval $ emptyRenderable atitle ha va rot af pf = if ttext == "" then er else tval $ mapPickFn pf $ rlabel tstyle ha va rot ttext where tstyle = laxis_title_style_ (af l) ttext = laxis_title_ (af l) plots = tval $ mfill (layout1_plot_background_ l) $ plotsToRenderable l where mfill Nothing = id mfill (Just fs) = fillBackground fs (ba,la,ta,ra) = getAxes l baxis = tval $ maybe emptyRenderable (mapPickFn L1P_BottomAxis . axisToRenderable) ba taxis = tval $ maybe emptyRenderable (mapPickFn L1P_TopAxis . axisToRenderable) ta laxis = tval $ maybe emptyRenderable (mapPickFn L1P_LeftAxis . axisToRenderable) la raxis = tval $ maybe emptyRenderable (mapPickFn L1P_RightAxis . axisToRenderable) ra tl = tval $ axesSpacer fst ta fst la bl = tval $ axesSpacer fst ba snd la tr = tval $ axesSpacer snd ta fst ra br = tval $ axesSpacer snd ba snd ra plotsToRenderable :: Layout1 x y -> Renderable (Layout1Pick x y) plotsToRenderable l = Renderable { minsize = return (0,0), render = renderPlots l } renderPlots :: Layout1 x y -> RectSize -> CRender (PickFn (Layout1Pick x y)) renderPlots l sz@(w,h) = do when (not (layout1_grid_last_ l)) renderGrids preserveCState $ do -- render the plots setClipRegion (Point 0 0) (Point w h) mapM_ rPlot (layout1_plots_ l) when (layout1_grid_last_ l) renderGrids return pickfn where (bAxis,lAxis,tAxis,rAxis) = getAxes l rPlot (Left p) = rPlot1 bAxis lAxis p rPlot (Right p) = rPlot1 bAxis rAxis p xr = (0, w) yr = (h, 0) reverse rev (a,b) = if rev then (b,a) else (a,b) rPlot1 (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p = let xr1 = reverse xrev xr yr1 = reverse yrev yr yrange = if yrev then (0, h) else (h, 0) pmfn (x,y) = Point (mapv xr1 (axis_viewport_ xaxis xr1) x) (mapv yr1 (axis_viewport_ yaxis yr1) y) mapv (min,max) _ LMin = min mapv (min,max) _ LMax = max mapv _ f (LValue v) = f v in plot_render_ p pmfn rPlot1 _ _ _ = return () pickfn (Point x y) = do -- Maybe monad xat <- mxat (yat1,yat2) <- myats return (L1P_PlotArea (mapx xat x) (mapy yat1 y) (mapy yat2 y)) where mxat = case (bAxis,tAxis) of (Just at,_) -> Just at (_,Just at) -> Just at (Nothing,Nothing) -> Nothing myats = case (lAxis,rAxis) of (Just at,Nothing) -> Just (at,at) (Nothing,Just at) -> Just (at,at) (Just at1,Just at2) -> Just (at1,at2) (Nothing,Nothing) -> Nothing mapx (AxisT _ _ rev ad) x = axis_tropweiv_ ad (reverse rev xr) x mapy (AxisT _ _ rev ad) y = axis_tropweiv_ ad (reverse rev yr) y renderGrids = do maybeM () (renderAxisGrid sz) tAxis maybeM () (renderAxisGrid sz) bAxis maybeM () (renderAxisGrid sz) lAxis maybeM () (renderAxisGrid sz) rAxis 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)) getAxes :: Layout1 x y -> (Maybe (AxisT x), Maybe (AxisT y), Maybe (AxisT x), Maybe (AxisT y)) getAxes l = (bAxis,lAxis,tAxis,rAxis) where (xvals0,xvals1,yvals0,yvals1) = allPlottedValues (layout1_plots_ l) xvals = xvals0 ++ xvals1 (yvals0',yvals1') = layout1_yaxes_control_ l (yvals0,yvals1) bAxis = mkAxis E_Bottom (layout1_bottom_axis_ l) xvals tAxis = mkAxis E_Top (layout1_top_axis_ l) xvals lAxis = mkAxis E_Left (layout1_left_axis_ l) yvals0' rAxis = mkAxis E_Right (layout1_right_axis_ l) yvals1' mkAxis t laxis vals = case laxis_visible_ laxis vals of False -> Nothing True -> Just (AxisT t style rev adata) where style = laxis_style_ laxis rev = laxis_reverse_ laxis adata = (laxis_override_ laxis) (laxis_generate_ laxis vals) allPlottedValues :: [(Either (Plot x y) (Plot x' y'))] -> ( [x], [x'], [y], [y'] ) allPlottedValues plots = (xvals0,xvals1,yvals0,yvals1) where xvals0 = [ x | (Left p) <- plots, x <- fst $ plot_all_points_ p] yvals0 = [ y | (Left p) <- plots, y <- snd $ plot_all_points_ p] xvals1 = [ x | (Right p) <- plots, x <- fst $ plot_all_points_ p] yvals1 = [ y | (Right p) <- plots, y <- snd $ plot_all_points_ p] defaultLayout1 :: (PlotValue x,PlotValue y) => Layout1 x y defaultLayout1 = Layout1 { layout1_background_ = solidFillStyle $ opaque white, layout1_plot_background_ = Nothing, layout1_title_ = "", layout1_title_style_ = defaultFontStyle{font_size_ =15 ,font_weight_ =C.FontWeightBold}, layout1_top_axis_ = defaultLayoutAxis {laxis_visible_ = const False}, layout1_bottom_axis_ = defaultLayoutAxis, layout1_left_axis_ = defaultLayoutAxis, layout1_right_axis_ = defaultLayoutAxis, layout1_yaxes_control_ = id, layout1_margin_ = 10, layout1_plots_ = [], layout1_legend_ = Just defaultLegendStyle, layout1_grid_last_ = False } defaultLayoutAxis :: PlotValue t => LayoutAxis t defaultLayoutAxis = LayoutAxis { laxis_title_style_ = defaultFontStyle{font_size_=10}, laxis_title_ = "", laxis_style_ = defaultAxisStyle, laxis_visible_ = not.null, laxis_generate_ = autoAxis, laxis_override_ = id, laxis_reverse_ = False } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''Layout1 ) $( deriveAccessors ''LayoutAxis ) -- | Helper to update all axis styles on a Layout1 simultaneously. updateAllAxesStyles :: (AxisStyle -> AxisStyle) -> Layout1 x y -> Layout1 x y updateAllAxesStyles uf = (layout1_top_axis .> laxis_style ^: uf) . (layout1_bottom_axis .> laxis_style ^: uf) . (layout1_left_axis .> laxis_style ^: uf) . (layout1_right_axis .> laxis_style ^: uf) -- | Helper to set the forground color uniformly on a Layout1. setLayout1Foreground :: AlphaColour Double -> Layout1 x y -> Layout1 x y setLayout1Foreground fg = updateAllAxesStyles ( (axis_line_style .> line_color ^= fg) . (axis_label_style .> font_color ^= fg)) . (layout1_title_style .> font_color ^= fg) . (layout1_legend ^: fmap (legend_label_style .> font_color ^= fg)) linkAxes :: ([a], [a]) -> ([a], [a]) linkAxes (ys1,ys2) = (ys1++ys2,ys1++ys2) independentAxes :: (a, b) -> (a, b) independentAxes (ys1,ys2) = (ys1,ys2) Chart-0.16/Graphics/Rendering/Chart/Renderable.hs0000644000000000000000000002460412006610042020001 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Renderable -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- This module contains the definition of the 'Renderable' type, which -- is a composable drawing element, along with assorted functions to -- them. -- module Graphics.Rendering.Chart.Renderable( Renderable(..), ToRenderable(..), PickFn, renderableToPNGFile, renderableToPDFFile, renderableToPSFile, renderableToSVGFile, vectorEnv, bitmapEnv, fillBackground, addMargins, emptyRenderable, embedRenderable, label, rlabel, spacer, spacer1, setPickFn, mapMaybePickFn, mapPickFn, nullPickFn, rect_minsize, rect_fillStyle, rect_lineStyle, rect_cornerStyle, ) where import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as Matrix import Control.Monad import Data.Accessor import Data.List ( nub, transpose, sort ) import Graphics.Rendering.Chart.Types -- | A function that maps a point in device coordinates to some value. -- -- Perhaps it might be generalised from Maybe a to -- (MonadPlus m ) => m a in the future. type PickFn a = Point -> (Maybe a) nullPickFn :: PickFn a nullPickFn = const Nothing -- | A Renderable is a record of functions required to layout a -- graphic element. data Renderable a = Renderable { -- | A Cairo action to calculate a minimum size. minsize :: CRender RectSize, -- | A Cairo action for drawing it within a rectangle. -- The rectangle is from the origin to the given point. -- -- The resulting "pick" function maps a point in the image to a value. render :: RectSize -> CRender (PickFn a) } -- | A type class abtracting the conversion of a value to a Renderable. class ToRenderable a where toRenderable :: a -> Renderable () emptyRenderable :: Renderable a emptyRenderable = spacer (0,0) -- | Create a blank renderable with a specified minimum size. spacer :: RectSize -> Renderable a spacer sz = Renderable { minsize = return sz, render = \_ -> return nullPickFn } -- | Create a blank renderable with a minimum size the same as -- some other renderable. spacer1 :: Renderable a -> Renderable b spacer1 r = r{ render = \_ -> return nullPickFn } -- | Replace the pick function of a renderable with another. setPickFn :: PickFn b -> Renderable a -> Renderable b setPickFn pickfn r = r{ render = \sz -> do { render r sz; return pickfn; } } -- | Map a function over the result of a renderable's pickfunction, keeping only 'Just' results. mapMaybePickFn :: (a -> Maybe b) -> Renderable a -> Renderable b mapMaybePickFn f r = r{ render = \sz -> do pf <- render r sz return (join . fmap f . pf) } -- | Map a function over result of a renderable's pickfunction. mapPickFn :: (a -> b) -> Renderable a -> Renderable b mapPickFn f = mapMaybePickFn (Just . f) -- | Add some spacing at the edges of a renderable. addMargins :: (Double,Double,Double,Double) -- ^ The spacing to be added. -> Renderable a -- ^ The source renderable. -> Renderable a 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 (w,h) = do preserveCState $ do c $ C.translate l t pickf <- render rd (w-l-r,h-t-b) return (mkpickf pickf (t,b,l,r) (w,h)) mkpickf pickf (t,b,l,r) (w,h) (Point x y) | x >= l && x <= w-r && y >= t && t <= h-b = pickf (Point (x-l) (y-t)) | otherwise = Nothing -- | Overlay a renderable over a solid background fill. fillBackground :: CairoFillStyle -> Renderable a -> Renderable a fillBackground fs r = r{ render = rf } where rf rsize@(w,h) = do preserveCState $ do setClipRegion (Point 0 0) (Point w h) setFillStyle fs c $ C.paint render r rsize -- | Output the given renderable to a PNG file of the specifed size -- (in pixels), to the specified file. renderableToPNGFile :: Renderable a -> Int -> Int -> FilePath -> IO (PickFn a) renderableToPNGFile chart width height path = C.withImageSurface C.FormatARGB32 width height $ \result -> do pick <- C.renderWith result $ runCRender rfn bitmapEnv C.surfaceWriteToPNG result path return pick where rfn = do render chart (fromIntegral width, fromIntegral height) renderableToFile withSurface chart width height path = withSurface path (fromIntegral width) (fromIntegral height) $ \result -> do C.renderWith result $ runCRender rfn vectorEnv C.surfaceFinish result where rfn = do render chart (fromIntegral width, fromIntegral height) c $ C.showPage -- | Output the given renderable to a PDF file of the specifed size -- (in points), to the specified file. renderableToPDFFile :: Renderable a -> Int -> Int -> FilePath -> IO () renderableToPDFFile = renderableToFile C.withPDFSurface -- | Output the given renderable to a postscript file of the specifed size -- (in points), to the specified file. renderableToPSFile :: Renderable a -> Int -> Int -> FilePath -> IO () renderableToPSFile = renderableToFile C.withPSSurface -- | Output the given renderable to an SVG file of the specifed size -- (in points), to the specified file. renderableToSVGFile :: Renderable a -> Int -> Int -> FilePath -> IO () renderableToSVGFile = renderableToFile C.withSVGSurface bitmapEnv :: CEnv bitmapEnv = CEnv (adjfn 0.5) (adjfn 0.0) where adjfn offset (Point x y) = Point (adj x) (adj y) where adj v = (fromIntegral.round) v +offset vectorEnv :: CEnv vectorEnv = CEnv id id -- | Helper function for using a renderable, when we generate it -- in the CRender monad. embedRenderable :: CRender (Renderable a) -> Renderable a embedRenderable ca = Renderable { minsize = do { a <- ca; minsize a }, render = \ r -> do { a <- ca; render a r } } ---------------------------------------------------------------------- -- Labels -- | Construct a renderable from a text string, aligned with the axes. label :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> String -> Renderable String label fs hta vta = rlabel fs hta vta 0 -- | Construct a renderable from a text string, rotated wrt to axes. The angle -- of rotation is in degrees. rlabel :: CairoFontStyle -> HTextAnchor -> VTextAnchor -> Double -> String -> Renderable String rlabel fs hta vta rot s = Renderable { minsize = mf, render = rf } where mf = preserveCState $ do setFontStyle fs (w,h) <- textSize s return (w*acr+h*asr,w*asr+h*acr) rf (w0,h0) = preserveCState $ do setFontStyle fs sz@(w,h) <- textSize s fe <- c $ C.fontExtents c $ C.translate 0 (-C.fontExtentsDescent fe) c $ C.translate (xadj sz hta 0 w0) (yadj sz vta 0 h0) c $ C.rotate rot' c $ C.moveTo (-w/2) (h/2) c $ C.showText s return (\_-> Just s) -- PickFn String 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) ---------------------------------------------------------------------- -- Rectangles data RectCornerStyle = RCornerSquare | RCornerBevel Double | RCornerRounded Double data Rectangle = Rectangle { rect_minsize_ :: RectSize, rect_fillStyle_ :: Maybe CairoFillStyle, rect_lineStyle_ :: Maybe CairoLineStyle, rect_cornerStyle_ :: RectCornerStyle } -- | Accessor for field rect_minsize_. rect_minsize :: Accessor Rectangle RectSize rect_minsize = accessor (\v->rect_minsize_ v) (\a v -> v{rect_minsize_=a}) -- | Accessor for field rect_fillStyle_. rect_fillStyle :: Accessor Rectangle (Maybe CairoFillStyle) rect_fillStyle = accessor (\v->rect_fillStyle_ v) (\a v -> v{rect_fillStyle_=a}) -- | Accessor for field rect_lineStyle_. rect_lineStyle :: Accessor Rectangle (Maybe CairoLineStyle) rect_lineStyle = accessor (\v->rect_lineStyle_ v) (\a v -> v{rect_lineStyle_=a}) -- | Accessor for field rect_cornerStyle_. rect_cornerStyle :: Accessor Rectangle RectCornerStyle rect_cornerStyle = accessor (\v->rect_cornerStyle_ v) (\a v -> v{rect_cornerStyle_=a}) defaultRectangle :: Rectangle defaultRectangle = Rectangle { rect_minsize_ = (0,0), rect_fillStyle_ = Nothing, rect_lineStyle_ = Nothing, rect_cornerStyle_ = RCornerSquare } instance ToRenderable Rectangle where toRenderable rectangle = Renderable mf rf where mf = return (rect_minsize_ rectangle) rf sz = preserveCState $ do maybeM () (fill sz) (rect_fillStyle_ rectangle) maybeM () (stroke sz) (rect_lineStyle_ rectangle) return nullPickFn fill sz fs = do setFillStyle fs strokeRectangle sz (rect_cornerStyle_ rectangle) c $ C.fill stroke sz ls = do setLineStyle ls strokeRectangle sz (rect_cornerStyle_ rectangle) c $ C.stroke strokeRectangle (x2,y2) RCornerSquare = c $ do let (x1,y1) = (0,0) C.moveTo x1 y1 C.lineTo x1 y2 C.lineTo x2 y2 C.lineTo x2 y1 C.lineTo x1 y1 C.lineTo x1 y2 strokeRectangle (x2,y2) (RCornerBevel s) = c $ do let (x1,y1) = (0,0) C.moveTo x1 (y1+s) C.lineTo x1 (y2-s) C.lineTo (x1+s) y2 C.lineTo (x2-s) y2 C.lineTo x2 (y2-s) C.lineTo x2 (y1+s) C.lineTo (x2-s) y1 C.lineTo (x1+s) y1 C.lineTo x1 (y1+s) C.lineTo x1 (y2-s) strokeRectangle (x2,y2) (RCornerRounded s) = c $ do let (x1,y1) = (0,0) C.arcNegative (x1+s) (y2-s) s (pi2*2) pi2 C.arcNegative (x2-s) (y2-s) s pi2 0 C.arcNegative (x2-s) (y1+s) s 0 (pi2*3) C.arcNegative (x1+s) (y1+s) s (pi2*3) (pi2*2) C.lineTo x1 (y2-s) pi2 = pi / 2 Chart-0.16/Graphics/Rendering/Chart/SparkLine.hs0000644000000000000000000001426412006610042017627 0ustar0000000000000000--------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Sparkline -- Copyright : (c) Hitesh Jasani, 2008, Malcolm Wallace 2011 -- License : BSD3 -- -- Created : 2008-02-26 -- Modified : 2011-02-11 -- Version : 0.2 -- -- Sparklines implementation in Haskell. Sparklines are -- mini graphs inspired by Edward Tufte. -- -- The original implementation (by Hitesh Jasani) used the gd -- package as a backend renderer, and is still available at -- http://hackage.haskell.org/package/hsparklines -- The present version uses Cairo as its renderer, and integrates with -- the Chart package, in the sense that Sparklines are just another -- kind of (ToRenderable a => a), so can be composed into grids etc. -- -- > dp :: [Double] -- > dp = [24,21,32.3,24,15,34,43,55,57,72,74,75,73,72,55,44] -- > -- > sparkLineToPNG "bar_spark.png" (SparkLine barSpark dp) -- > --------------------------------------------------------------- module Graphics.Rendering.Chart.SparkLine ( -- * SparkLine type SparkLine(..) -- * Drawing options , SparkOptions(..) , smoothSpark , barSpark -- * Size calculation , sparkSize -- * Rendering function , renderSparkLine , sparkLineToPNG , sparkLineToPDF ) where import Control.Monad import Data.List import Data.Ord import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Data.Colour import Data.Colour.Names -- | A sparkline is a single sequence of data values, treated as y-values. -- The x-values are anonymous and implicit in the sequence. data SparkLine = SparkLine { sl_options :: SparkOptions , sl_data :: [Double] } -- | Options to render the sparklines in different ways. data SparkOptions = SparkOptions { so_smooth :: Bool -- ^ smooth or bars , so_step :: Int -- ^ step size , so_height :: Int -- ^ graph height (pixels) , so_limits :: (Double,Double) -- ^ data point limits , so_bgColor :: Colour Double -- ^ background color , so_minColor :: Colour Double -- ^ color of minimum datapoint , so_maxColor :: Colour Double -- ^ color of maximum datapoint , so_lastColor :: Colour Double -- ^ color of last datapoint , so_minMarker :: Bool -- ^ display minimum marker , so_maxMarker :: Bool -- ^ display maximum marker , so_lastMarker :: Bool -- ^ display last marker } deriving (Show) -- | Default options for a smooth sparkline. smoothSpark :: SparkOptions smoothSpark = SparkOptions { so_smooth = True , so_step = 2 , so_height = 20 , so_limits = (0,100) , so_bgColor = white , so_minColor = red , so_maxColor = green , so_lastColor = blue , so_minMarker = True , so_maxMarker = True , so_lastMarker = True } -- | Default options for a barchart sparkline. barSpark :: SparkOptions barSpark = smoothSpark { so_smooth=False } instance ToRenderable SparkLine where toRenderable sp = Renderable { minsize = return (0, fromIntegral (so_height (sl_options sp))) , render = \_rect-> renderSparkLine sp } -- | Compute the width of a SparkLine, for rendering purposes. sparkWidth :: SparkLine -> Int sparkWidth SparkLine{sl_options=opt, sl_data=ds} = let w = 4 + (so_step opt) * (length ds - 1) + extrawidth extrawidth | so_smooth opt = 0 | otherwise = bw * length ds bw | so_smooth opt = 0 | otherwise = 2 in w sparkSize :: SparkLine -> (Int,Int) sparkSize s = (sparkWidth s, so_height (sl_options s)) -- | Render a SparkLine to a drawing surface using cairo. renderSparkLine :: SparkLine -> CRender (PickFn ()) renderSparkLine SparkLine{sl_options=opt, sl_data=ds} = let w = 4 + (so_step opt) * (length ds - 1) + extrawidth extrawidth | so_smooth opt = 0 | otherwise = bw * length ds bw | so_smooth opt = 0 | otherwise = 2 h = so_height opt dmin = fst (so_limits opt) dmax = snd (so_limits opt) coords = zipWith (\x y-> Point (fi x) y) [1,(1+bw+so_step opt)..(1+(so_step opt+bw)*(length ds))] [ fi h - ( (y-dmin) / ((dmax-dmin+1) / fi (h-4)) ) | y <- ds ] -- remember y increases as we go down the page minpt = maximumBy (comparing p_y) coords maxpt = minimumBy (comparing p_y) coords endpt = last coords boxpt :: Point -> Rect boxpt (Point x y) = Rect (Point (x-1)(y-1)) (Point (x+1)(y+1)) fi :: (Num b, Integral a) => a -> b fi = fromIntegral in preserveCState $ do setFillStyle (solidFillStyle (opaque (so_bgColor opt))) fillPath (rectPath (Rect (Point 0 0) (Point (fi w) (fi h)))) if so_smooth opt then do setLineStyle (solidLine 1 (opaque grey)) strokePath coords else do setFillStyle (solidFillStyle (opaque grey)) forM_ coords $ \ (Point x y) -> fillPath (rectPath (Rect (Point (x-1) y) (Point (x+1) (fi h)))) when (so_minMarker opt) $ do setFillStyle (solidFillStyle (opaque (so_minColor opt))) fillPath (rectPath (boxpt minpt)) when (so_maxMarker opt) $ do setFillStyle (solidFillStyle (opaque (so_maxColor opt))) fillPath (rectPath (boxpt maxpt)) when (so_lastMarker opt) $ do setFillStyle (solidFillStyle (opaque (so_lastColor opt))) fillPath (rectPath (boxpt endpt)) return nullPickFn -- | Generate a PNG for the sparkline, using its natural size. sparkLineToPNG :: FilePath -> SparkLine -> IO (PickFn ()) sparkLineToPNG fp sp = renderableToPNGFile (toRenderable sp) (sparkWidth sp) (so_height (sl_options sp)) fp -- | Generate a PDF for the sparkline, using its natural size. sparkLineToPDF :: FilePath -> SparkLine -> IO () sparkLineToPDF fp sp = renderableToPDFFile (toRenderable sp) (sparkWidth sp) (so_height (sl_options sp)) fp Chart-0.16/Graphics/Rendering/Chart/Plot.hs0000644000000000000000000000264712006610042016657 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Code to calculate and render various types of plots. -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot( module Graphics.Rendering.Chart.Plot.Types, module Graphics.Rendering.Chart.Plot.Lines, module Graphics.Rendering.Chart.Plot.Points, module Graphics.Rendering.Chart.Plot.FillBetween, module Graphics.Rendering.Chart.Plot.ErrBars, module Graphics.Rendering.Chart.Plot.Candle, module Graphics.Rendering.Chart.Plot.Bars, module Graphics.Rendering.Chart.Plot.Hidden, module Graphics.Rendering.Chart.Plot.Annotation, module Graphics.Rendering.Chart.Plot.AreaSpots, module Graphics.Rendering.Chart.Plot.Pie, ) where import Graphics.Rendering.Chart.Plot.Types import Graphics.Rendering.Chart.Plot.Lines import Graphics.Rendering.Chart.Plot.Points import Graphics.Rendering.Chart.Plot.FillBetween import Graphics.Rendering.Chart.Plot.ErrBars import Graphics.Rendering.Chart.Plot.Candle import Graphics.Rendering.Chart.Plot.Bars import Graphics.Rendering.Chart.Plot.Hidden import Graphics.Rendering.Chart.Plot.Annotation import Graphics.Rendering.Chart.Plot.AreaSpots import Graphics.Rendering.Chart.Plot.Pie Chart-0.16/Graphics/Rendering/Chart/Grid.hs0000644000000000000000000002737112006610042016627 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Grid -- Copyright : (c) Tim Docker 2010 -- License : BSD-style (see chart/COPYRIGHT) -- -- A container type for values that can be composed by horizonal -- and vertical layout. module Graphics.Rendering.Chart.Grid ( Grid, Span, tval, tspan, empty, nullt, (.|.), (./.), above, aboveN, beside, besideN, overlay, width, height, gridToRenderable, weights, fullRowAbove, fullRowBelow, fullColLeft, fullColRight, fullOverlayUnder, fullOverlayOver ) where import Data.List import Data.Array import Control.Monad import Control.Monad.Trans import Numeric import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Types import qualified Graphics.Rendering.Cairo as C import Data.Colour import Data.Colour.Names type Span = (Int,Int) type Size = (Int,Int) -- | When more space is available for an item than the total width of items, -- extra added space is proportional to 'space weight'. type SpaceWeight = (Double,Double) type Cell a = (a,Span,SpaceWeight) -- | Abstract datatype representing a grid. data Grid a = Value (a,Span,SpaceWeight) -- ^ A singleton grid item "a" spanning -- a given rectangle (measured in grid -- cells), with given space weight. | Above (Grid a) (Grid a) Size -- ^ One grid above the other. "Size" is -- their cached total size (so it is -- NOT specified manually). | Beside (Grid a) (Grid a) Size -- ^ One grid horizontally beside -- the other. | Overlay (Grid a) (Grid a) Size -- ^ Two grids positioned one over -- the other. | Empty -- ^ An empty 1x1 grid cell. | Null -- ^ An empty 0x0 grid cell. deriving (Show) width :: Grid a -> Int width Null = 0 width Empty = 1 width (Value _) = 1 width (Beside _ _ (w,h)) = w width (Above _ _ (w,h)) = w width (Overlay _ _ (w,h)) = w height :: Grid a -> Int height Null = 0 height Empty = 1 height (Value _) = 1 height (Beside _ _ (w,h)) = h height (Above _ _ (w,h)) = h height (Overlay _ _ (w,h)) = h -- | A 1x1 grid from a given value, with no extra space. tval :: a -> Grid a tval a = Value (a,(1,1),(0,0)) -- | A WxH (measured in cells) grid from a given value, with space weight (1,1). tspan :: a -> Span -> Grid a tspan a span = Value (a,span,(1,1)) -- | A 1x1 empty grid. empty :: Grid a empty = Empty -- | A 0x0 empty grid. nullt :: Grid a nullt = Null above, beside :: Grid a -> Grid a -> Grid a above Null t = t above t Null = t above t1 t2 = Above t1 t2 size where size = (max (width t1) (width t2), height t1 + height t2) -- | A value placed above the grid, occupying 1 row with the same -- horizontal span as the grid. fullRowAbove :: a -> Double -> Grid a -> Grid a fullRowAbove a w g = (weights (0,w) $ tspan a (width g,1)) `above` g -- | A value placed below the grid, occupying 1 row with the same -- horizontal span as the grid. fullRowBelow :: a -> Double -> Grid a -> Grid a fullRowBelow a w g = g `above` (weights (0,w) $ tspan a (width g,1)) -- | A value placed to the left of the grid, occupying 1 column with -- the same vertical span as the grid. fullColLeft :: a -> Double -> Grid a -> Grid a fullColLeft a w g = (weights (w,0) $ tspan a (1,height g)) `beside` g -- | A value placed to the right of the grid, occupying 1 column with -- the same vertical span as the grid. fullColRight :: a -> Double -> Grid a -> Grid a fullColRight a w g = g `beside` (weights (w,0) $ tspan a (1,height g)) -- | A value placed under a grid, with the same span as the grid. fullOverlayUnder :: a -> Grid a -> Grid a fullOverlayUnder a g = g `overlay` (tspan a (width g,height g)) -- | A value placed over a grid, with the same span as the grid. fullOverlayOver :: a -> Grid a -> Grid a fullOverlayOver a g = (tspan a (width g,height g)) `overlay` g beside Null t = t beside t Null = t beside t1 t2 = Beside t1 t2 size where size = (width t1 + width t2, max (height t1) (height t2)) aboveN, besideN :: [Grid a] -> Grid a aboveN = foldl above nullt besideN = foldl beside nullt -- | One grid over the other. The first argument is shallow, the second is deep. overlay :: Grid a -> Grid a -> Grid a overlay Null t = t overlay t Null = t overlay t1 t2 = Overlay t1 t2 size where size = (max (width t1) (width t2), max (height t1) (height t2)) -- | A synonym for 'beside'. (.|.) :: Grid a -> Grid a -> Grid a (.|.) = beside -- | A synonym for 'above'. (./.) :: Grid a -> Grid a -> Grid a (./.) = above -- | Sets the space weight of *every* cell of the grid to given value. weights :: SpaceWeight -> Grid a -> Grid a weights sw Null = Null weights sw Empty = Empty weights sw (Value (v,sp,_)) = Value (v,sp,sw) weights sw (Above t1 t2 sz) = Above (weights sw t1) (weights sw t2) sz weights sw (Beside t1 t2 sz) = Beside (weights sw t1) (weights sw t2) sz weights sw (Overlay t1 t2 sz) = Overlay (weights sw t1) (weights sw t2) sz -- fix me, need to make .|. and .||. higher precedence -- than ./. and .//. instance Functor Grid where fmap f (Value (a,span,ew)) = Value (f a,span,ew) fmap f (Above t1 t2 s) = Above (fmap f t1) (fmap f t2) s fmap f (Beside t1 t2 s) = Beside (fmap f t1) (fmap f t2) s fmap f (Overlay t1 t2 s) = Overlay (fmap f t1) (fmap f t2) s fmap f Empty = Empty fmap f Null = Null mapGridM :: Monad m => (a -> m b) -> Grid a -> m (Grid b) mapGridM f (Value (a,span,ew)) = do b <- f a return (Value (b,span,ew)) mapGridM f (Above t1 t2 s) = do t1' <- mapGridM f t1 t2' <- mapGridM f t2 return (Above t1' t2' s) mapGridM f (Beside t1 t2 s) = do t1' <- mapGridM f t1 t2' <- mapGridM f t2 return (Beside t1' t2' s) mapGridM f (Overlay t1 t2 s) = do t1' <- mapGridM f t1 t2' <- mapGridM f t2 return (Overlay t1' t2' s) mapGridM _ Empty = return Empty mapGridM _ Null = return Null ---------------------------------------------------------------------- type FlatGrid a = Array (Int,Int) [(a,Span,SpaceWeight)] flatten :: Grid a -> FlatGrid a flatten t = accumArray (flip (:)) [] ((0,0), (width t - 1, height t - 1)) (flatten2 (0,0) t []) type FlatEl a = ((Int,Int),Cell a) flatten2 :: (Int,Int) -> Grid a -> [FlatEl a] -> [FlatEl a] flatten2 i Empty els = els flatten2 i Null els = els flatten2 i (Value cell) els = (i,cell):els flatten2 i@(x,y) (Above t1 t2 size) els = (f1.f2) els where f1 = flatten2 i t1 f2 = flatten2 (x,y + height t1) t2 flatten2 i@(x,y) (Beside t1 t2 size) els = (f1.f2) els where f1 = flatten2 i t1 f2 = flatten2 (x + width t1, y) t2 flatten2 i@(x,y) (Overlay t1 t2 size) els = (f1.f2) els where f1 = flatten2 i t1 f2 = flatten2 i t2 foldT :: ((Int,Int) -> Cell a -> r -> r) -> r -> FlatGrid a -> r foldT f iv ft = foldr f' iv (assocs ft) where f' (i,vs) r = foldr (\cell -> f i cell) r vs ---------------------------------------------------------------------- type DArray = Array Int Double getSizes :: Grid (Renderable a) -> CRender (DArray, DArray, DArray, DArray) getSizes t = do szs <- mapGridM minsize t :: CRender (Grid RectSize) let szs' = flatten szs let widths = accumArray max 0 (0, width t - 1) (foldT (ef wf fst) [] szs') let heights = accumArray max 0 (0, height t - 1) (foldT (ef hf snd) [] szs') let xweights = accumArray max 0 (0, width t - 1) (foldT (ef xwf fst) [] szs') let yweights = accumArray max 0 (0, height t - 1) (foldT (ef ywf snd) [] szs') return (widths,heights,xweights,yweights) where wf (x,y) (w,h) (ww,wh) = (x,w) hf (x,y) (w,h) (ww,wh) = (y,h) xwf (x,y) (w,h) (xw,yw) = (x,xw) ywf (x,y) (w,h) (xw,yw) = (y,yw) ef f ds loc (size,span,ew) r | ds span == 1 = (f loc size ew:r) | otherwise = r instance (ToRenderable a) => ToRenderable (Grid a) where toRenderable = gridToRenderable . fmap toRenderable gridToRenderable :: Grid (Renderable a) -> Renderable a gridToRenderable t = Renderable minsizef renderf where minsizef :: CRender RectSize minsizef = do (widths, heights, xweights, yweights) <- getSizes t return (sum (elems widths), sum (elems heights)) renderf (w,h) = do (widths, heights, xweights, yweights) <- getSizes t let widths' = addExtraSpace w widths xweights let heights' = addExtraSpace h heights yweights let borders = (ctotal widths',ctotal heights') rf1 borders (0,0) t -- (x borders, y borders) -> (x,y) -> grid -> drawing rf1 borders loc@(i,j) t = case t of Null -> return nullPickFn Empty -> return nullPickFn (Value (r,span,_)) -> do let (Rect p0 p1) = mkRect borders loc span p0'@(Point x0 y0) <- alignc p0 p1'@(Point x1 y1) <- alignc p1 preserveCState $ do c $ C.translate x0 y0 pf <- render r (x1-x0,y1-y0) return (newpf pf x0 y0) (Above t1 t2 _) -> do pf1 <- rf1 borders (i,j) t1 pf2 <- rf1 borders (i,j+height t1) t2 let pf p@(Point x y) = if y < (snd borders ! (j + height t1)) then pf1 p else pf2 p return pf (Beside t1 t2 _) -> do pf1 <- rf1 borders (i,j) t1 pf2 <- rf1 borders (i+width t1,j) t2 let pf p@(Point x y) = if x < (fst borders ! (i + width t1)) then pf1 p else pf2 p return pf (Overlay t1 t2 _) -> do pf2 <- rf1 borders (i,j) t2 pf1 <- rf1 borders (i,j) t1 let pf p = pf1 p `mplus` pf2 p return pf newpf pf x0 y0 = \ (Point x1 y1)-> pf (Point (x1-x0) (y1-y0)) -- (x borders, y borders) -> (x,y) -> (w,h) -- -> rectangle of grid[x..x+w, y..y+h] mkRect :: (DArray, DArray) -> (Int,Int) -> (Int,Int) -> Rect mkRect (cwidths,cheights) (x,y) (w,h) = Rect (Point x1 y1) (Point x2 y2) where x1 = cwidths ! x y1 = cheights ! y x2 = cwidths ! min (x+w) (snd $ bounds cwidths) y2 = cheights ! min (y+h) (snd $ bounds cheights) mx = fst (bounds cwidths) my = fst (bounds cheights) -- total size -> item sizes -> item weights -> new item sizes such that -- their sum == total size, and added size is proportional to weight addExtraSpace :: Double -> DArray -> DArray -> DArray addExtraSpace size sizes weights = if totalws == 0 then sizes else listArray (bounds sizes) sizes' where ws = elems weights totalws = sum ws extra = size - sum (elems sizes) extras = map (*(extra/totalws)) ws sizes' = zipWith (+) extras (elems sizes) -- [1,2,3] -> [0,1,3,6]. ctotal :: DArray -> DArray ctotal a = listArray (let (i,j) = bounds a in (i,j+1)) (scanl (+) 0 (elems a)) Chart-0.16/Graphics/Rendering/Chart/Simple.hs0000644000000000000000000000306412006610042017164 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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 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: -- -- > 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, plotPDF, plotPS, plotLayout, plotPNG, Layout1DDD ) where import Graphics.Rendering.Chart.Simple.Internal Chart-0.16/Graphics/Rendering/Chart/Types.hs0000644000000000000000000004412412006610042017041 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Types -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- This module contains basic types and functions used for drawing. -- -- Note that template haskell is used to derive accessor functions -- (see 'Data.Accessor') for each field of the following data types: -- -- * 'CairoLineStyle' -- -- * 'CairoFontStyle' -- -- These accessors are not shown in this API documentation. They have -- the same name as the field, but with the trailing underscore -- dropped. Hence for data field f_::F in type D, they have type -- -- @ -- f :: Data.Accessor.Accessor D F -- @ -- module Graphics.Rendering.Chart.Types( Rect(..), Point(..), Vector(..), RectSize, Range, mkrect, pvadd, pvsub, psub, vscale, within, RectEdge(..), Limit(..), PointMapFn, preserveCState, setClipRegion, moveTo, lineTo, rectPath, strokePath, fillPath, isValidNumber, maybeM, defaultColorSeq, setSourceColor, CairoLineStyle(..), solidLine, dashedLine, setLineStyle, CairoFillStyle(..), defaultPointStyle, solidFillStyle, setFillStyle, CairoFontStyle(..), defaultFontStyle, setFontStyle, CairoPointStyle(..), filledPolygon, hollowPolygon, filledCircles, hollowCircles, plusses, exes, stars, HTextAnchor(..), VTextAnchor(..), drawText, drawTextR, drawTextsR, textSize, textDrawRect, CRender(..), CEnv(..), runCRender, c, alignp, alignc, line_width, line_color, line_dashes, line_cap, line_join, font_name, font_size, font_slant, font_weight, font_color, ) where import qualified Graphics.Rendering.Cairo as C import Control.Monad.Reader import Data.Accessor import Data.Accessor.Template import Data.Colour import Data.Colour.SRGB import Data.Colour.Names import Data.List (unfoldr) -- | A point in two dimensions. data Point = Point { p_x :: Double, p_y :: Double } deriving Show data Vector = Vector { v_x :: Double, v_y :: Double } deriving Show -- | Scale a vector by a constant. vscale :: Double -> Vector -> Vector vscale c (Vector x y) = (Vector (x*c) (y*c)) -- | Add a point and a vector. pvadd :: Point -> Vector -> Point pvadd (Point x1 y1) (Vector x2 y2) = (Point (x1+x2) (y1+y2)) -- | Subtract a vector from a point. pvsub :: Point -> Vector -> Point pvsub (Point x1 y1) (Vector x2 y2) = (Point (x1-x2) (y1-y2)) -- | Subtract two points. psub :: Point -> Point -> Vector psub (Point x1 y1) (Point x2 y2) = (Vector (x1-x2) (y1-y2)) data Limit a = LMin | LValue a | LMax deriving Show -- | A function mapping between points. type PointMapFn x y = (Limit x, Limit y) -> Point -- | A rectangle is defined by two points. data Rect = Rect Point Point deriving Show data RectEdge = E_Top | E_Bottom | E_Left | E_Right -- | Create a rectangle based upon the coordinates of 4 points. mkrect :: Point -> Point -> Point -> Point -> Rect mkrect (Point x1 _) (Point _ y2) (Point x3 _) (Point _ y4) = Rect (Point x1 y2) (Point x3 y4) -- | Test if a point is within a rectangle. within :: Point -> Rect -> Bool within (Point x y) (Rect (Point x1 y1) (Point x2 y2)) = x >= x1 && x <= x2 && y >= y1 && y <= y2 ---------------------------------------------------------------------- -- | The environment present in the CRender Monad. data CEnv = CEnv { -- | An adjustment applied immediately prior to points -- being displayed in device coordinates. -- -- When device coordinates correspond to pixels, a cleaner -- image is created if this transform rounds to the nearest -- pixel. With higher-resolution output, this transform can -- just be the identity function. cenv_point_alignfn :: Point -> Point, -- | A adjustment applied immediately prior to coordinates -- being transformed. cenv_coord_alignfn :: Point -> Point } -- | The reader monad containing context information to control -- the rendering process. newtype CRender a = DR (ReaderT CEnv C.Render a) deriving (Functor, Monad, MonadReader CEnv) runCRender :: CRender a -> CEnv -> C.Render a runCRender (DR m) e = runReaderT m e c :: C.Render a -> CRender a c = DR . lift ---------------------------------------------------------------------- -- | Abstract data type for the style of a plotted point. -- -- The contained Cairo action draws a point in the desired -- style, at the supplied device coordinates. newtype CairoPointStyle = CairoPointStyle (Point -> CRender ()) -- | Data type for the style of a line. data CairoLineStyle = CairoLineStyle { line_width_ :: Double, line_color_ :: AlphaColour Double, line_dashes_ :: [Double], line_cap_ :: C.LineCap, line_join_ :: C.LineJoin } -- | Abstract data type for a fill style. -- -- The contained Cairo action sets the required fill -- style in the Cairo rendering state. newtype CairoFillStyle = CairoFillStyle (CRender ()) -- | Data type for a font. data CairoFontStyle = CairoFontStyle { font_name_ :: String, font_size_ :: Double, font_slant_ :: C.FontSlant, font_weight_ :: C.FontWeight, font_color_ :: AlphaColour Double } type Range = (Double,Double) type RectSize = (Double,Double) defaultColorSeq :: [AlphaColour Double] defaultColorSeq = cycle $ map opaque [blue, red, green, yellow, cyan, magenta] ---------------------------------------------------------------------- -- Assorted helper functions in Cairo Usage moveTo, lineTo :: Point -> CRender () moveTo p = do p' <- alignp p c $ C.moveTo (p_x p') (p_y p') alignp :: Point -> CRender Point alignp p = do alignfn <- fmap cenv_point_alignfn ask return (alignfn p) alignc :: Point -> CRender Point alignc p = do alignfn <- fmap cenv_coord_alignfn ask return (alignfn p) lineTo p = do p' <- alignp p c $ C.lineTo (p_x p') (p_y p') setClipRegion :: Point -> Point -> CRender () setClipRegion p2 p3 = do c $ C.moveTo (p_x p2) (p_y p2) c $ C.lineTo (p_x p2) (p_y p3) c $ C.lineTo (p_x p3) (p_y p3) c $ C.lineTo (p_x p3) (p_y p2) c $ C.lineTo (p_x p2) (p_y p2) c $ C.clip -- | Make a path from a rectangle. rectPath :: Rect -> [Point] rectPath (Rect p1@(Point x1 y1) p3@(Point x2 y2)) = [p1,p2,p3,p4,p1] where p2 = (Point x1 y2) p4 = (Point x2 y1) stepPath :: [Point] -> CRender() stepPath (p:ps) = c $ do C.newPath C.moveTo (p_x p) (p_y p) mapM_ (\p -> C.lineTo (p_x p) (p_y p)) ps stepPath _ = return () -- | Draw lines between the specified points. -- -- The points will be "corrected" by the cenv_point_alignfn, so that -- when drawing bitmaps, 1 pixel wide lines will be centred on the -- pixels. strokePath :: [Point] -> CRender() strokePath pts = do alignfn <- fmap cenv_point_alignfn ask stepPath (map alignfn pts) c $ C.stroke -- | Fill the region with the given corners. -- -- The points will be "corrected" by the cenv_coord_alignfn, so that -- when drawing bitmaps, the edges of the region will fall between -- pixels. fillPath :: [Point] -> CRender() fillPath pts = do alignfn <- fmap cenv_coord_alignfn ask stepPath (map alignfn pts) c $ C.fill setFontStyle :: CairoFontStyle -> CRender () setFontStyle f = do c $ C.selectFontFace (font_name_ f) (font_slant_ f) (font_weight_ f) c $ C.setFontSize (font_size_ f) c $ setSourceColor (font_color_ f) setLineStyle :: CairoLineStyle -> CRender () setLineStyle ls = do c $ C.setLineWidth (line_width_ ls) c $ setSourceColor (line_color_ ls) c $ C.setLineCap (line_cap_ ls) c $ C.setLineJoin (line_join_ ls) c $ C.setDash (line_dashes_ ls) 0 setFillStyle :: CairoFillStyle -> CRender () setFillStyle (CairoFillStyle s) = s colourChannel :: (Floating a, Ord a) => AlphaColour a -> Colour a colourChannel c = darken (recip (alphaChannel c)) (c `over` black) setSourceColor :: AlphaColour Double -> C.Render () setSourceColor c = let (RGB r g b) = toSRGB $ colourChannel c in C.setSourceRGBA r g b (alphaChannel c) -- | Return the bounding rectangle for a text string rendered -- in the current context. textSize :: String -> CRender RectSize textSize s = c $ do te <- C.textExtents s fe <- C.fontExtents return (C.textExtentsWidth te, C.fontExtentsHeight fe) data HTextAnchor = HTA_Left | HTA_Centre | HTA_Right data VTextAnchor = VTA_Top | VTA_Centre | VTA_Bottom | VTA_BaseLine -- | Recturn the bounding rectangle for a text string positioned -- where it would be drawn by drawText textDrawRect :: HTextAnchor -> VTextAnchor -> Point -> String -> CRender Rect textDrawRect hta vta (Point x y) s = preserveCState $ textSize s >>= rect where rect (w,h) = c $ do te <- C.textExtents s fe <- C.fontExtents let lx = xadj hta (C.textExtentsWidth te) let ly = yadj vta te fe let (x',y') = (x + lx, y + ly) let p1 = Point x' y' let p2 = Point (x' + w) (y' + h) return $ Rect p1 p2 xadj HTA_Left w = 0 xadj HTA_Centre w = (-w/2) xadj HTA_Right w = (-w) yadj VTA_Top te fe = C.fontExtentsAscent fe yadj VTA_Centre te fe = - (C.textExtentsYbearing te) / 2 yadj VTA_BaseLine te fe = 0 yadj VTA_Bottom te fe = -(C.fontExtentsDescent fe) -- | Function to draw a textual label anchored by one of its corners -- or edges. drawText :: HTextAnchor -> VTextAnchor -> Point -> String -> CRender () drawText hta vta p s = drawTextR hta vta 0 p s -- | Function to draw a textual label anchored by one of its corners -- or edges, with rotation. Rotation angle is given in degrees, -- rotation is performed around anchor point. drawTextR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> CRender () drawTextR hta vta angle (Point x y) s = preserveCState $ draw where draw = c $ do te <- C.textExtents s fe <- C.fontExtents let lx = xadj hta (C.textExtentsWidth te) let ly = yadj vta te fe C.translate x y C.rotate theta C.moveTo lx ly C.showText s theta = angle*pi/180.0 xadj HTA_Left w = 0 xadj HTA_Centre w = (-w/2) xadj HTA_Right w = (-w) yadj VTA_Top te fe = C.fontExtentsAscent fe yadj VTA_Centre te fe = - (C.textExtentsYbearing te) / 2 yadj VTA_BaseLine te fe = 0 yadj VTA_Bottom te fe = -(C.fontExtentsDescent fe) -- | Function to draw a multi-line textual label anchored by one of its corners -- or edges, with rotation. Rotation angle is given in degrees, -- rotation is performed around anchor point. drawTextsR :: HTextAnchor -> VTextAnchor -> Double -> Point -> String -> CRender () drawTextsR hta vta angle (Point x y) s = preserveCState $ drawAll where ss = lines s num = length ss drawAll = c $ do tes <- mapM C.textExtents ss fe <- C.fontExtents let widths = map C.textExtentsWidth tes maxw = maximum widths maxh = maximum (map C.textExtentsYbearing tes) gap = maxh / 2 -- half-line spacing totalHeight = fromIntegral num*maxh + (fromIntegral num-1)*gap ys = take num (unfoldr (\y-> Just (y, y-gap-maxh)) (yinit vta fe totalHeight)) xs = map (xadj hta) widths C.translate x y C.rotate theta sequence_ (zipWith3 draw xs ys ss) draw lx ly s = do C.moveTo lx ly C.showText s theta = angle*pi/180.0 xadj HTA_Left w = 0 xadj HTA_Centre w = (-w/2) xadj HTA_Right w = (-w) yinit VTA_Top fe height = C.fontExtentsAscent fe yinit VTA_BaseLine fe height = 0 yinit VTA_Centre fe height = height / 2 + C.fontExtentsAscent fe yinit VTA_Bottom fe height = height + C.fontExtentsAscent fe -- | Execute a rendering action in a saved context (ie bracketed -- between C.save and C.restore). preserveCState :: CRender a -> CRender a preserveCState a = do c $ C.save v <- a c $ C.restore return v ---------------------------------------------------------------------- filledCircles :: Double -- ^ Radius of circle. -> AlphaColour Double -- ^ Colour. -> CairoPointStyle filledCircles radius cl = CairoPointStyle rf where rf p = do (Point x y) <- alignp p c $ setSourceColor cl c $ C.newPath c $ C.arc x y radius 0 (2*pi) c $ C.fill hollowCircles :: Double -- ^ Radius of circle. -> Double -- ^ Thickness of line. -> AlphaColour Double -> CairoPointStyle hollowCircles radius w cl = CairoPointStyle rf where rf p = do (Point x y) <- alignp p c $ C.setLineWidth w c $ setSourceColor cl c $ C.newPath c $ C.arc x y radius 0 (2*pi) c $ C.stroke hollowPolygon :: Double -- ^ Radius of circle. -> Double -- ^ Thickness of line. -> Int -- ^ Number of vertices. -> Bool -- ^ Is right-side-up? -> AlphaColour Double -> CairoPointStyle hollowPolygon radius w sides isrot cl = CairoPointStyle rf where rf p = do (Point x y ) <- alignp p c $ C.setLineWidth w c $ setSourceColor cl c $ C.newPath let intToAngle n = if isrot then fromIntegral n * 2*pi / fromIntegral sides else (0.5 + fromIntegral n)*2*pi / fromIntegral sides angles = map intToAngle [0 .. sides-1] (p:ps) = map (\a -> Point (x + radius * sin a) (y + radius * cos a)) angles moveTo p mapM_ lineTo (ps++[p]) c $ C.stroke filledPolygon :: Double -- ^ Radius of circle. -> Int -- ^ Number of vertices. -> Bool -- ^ Is right-side-up? -> AlphaColour Double -> CairoPointStyle filledPolygon radius sides isrot cl = CairoPointStyle rf where rf p = do (Point x y ) <- alignp p c $ setSourceColor cl c $ C.newPath let intToAngle n = if isrot then fromIntegral n * 2*pi/fromIntegral sides else (0.5 + fromIntegral n)*2*pi/fromIntegral sides angles = map intToAngle [0 .. sides-1] (p:ps) = map (\a -> Point (x + radius * sin a) (y + radius * cos a)) angles moveTo p mapM_ lineTo (ps++[p]) c $ C.fill plusses :: Double -- ^ Radius of circle. -> Double -- ^ Thickness of line. -> AlphaColour Double -> CairoPointStyle plusses radius w cl = CairoPointStyle rf where rf p = do (Point x y ) <- alignp p c $ C.setLineWidth w c $ setSourceColor cl c $ C.newPath c $ C.moveTo (x+radius) y c $ C.lineTo (x-radius) y c $ C.moveTo x (y-radius) c $ C.lineTo x (y+radius) c $ C.stroke exes :: Double -- ^ Radius of circle. -> Double -- ^ Thickness of line. -> AlphaColour Double -> CairoPointStyle exes radius w cl = CairoPointStyle rf where rad = radius / sqrt 2 rf p = do (Point x y ) <- alignp p c $ C.setLineWidth w c $ setSourceColor cl c $ C.newPath c $ C.moveTo (x+rad) (y+rad) c $ C.lineTo (x-rad) (y-rad) c $ C.moveTo (x+rad) (y-rad) c $ C.lineTo (x-rad) (y+rad) c $ C.stroke stars :: Double -- ^ Radius of circle. -> Double -- ^ Thickness of line. -> AlphaColour Double -> CairoPointStyle stars radius w cl = CairoPointStyle rf where rad = radius / sqrt 2 rf p = do (Point x y ) <- alignp p c $ C.setLineWidth w c $ setSourceColor cl c $ C.newPath c $ C.moveTo (x+radius) y c $ C.lineTo (x-radius) y c $ C.moveTo x (y-radius) c $ C.lineTo x (y+radius) c $ C.moveTo (x+rad) (y+rad) c $ C.lineTo (x-rad) (y-rad) c $ C.moveTo (x+rad) (y-rad) c $ C.lineTo (x-rad) (y+rad) c $ C.stroke solidLine :: Double -- ^ Width of line. -> AlphaColour Double -> CairoLineStyle solidLine w cl = CairoLineStyle w cl [] C.LineCapButt C.LineJoinMiter dashedLine :: Double -- ^ Width of line. -> [Double] -- ^ The dash pattern in device coordinates. -> AlphaColour Double -> CairoLineStyle dashedLine w ds cl = CairoLineStyle w cl ds C.LineCapButt C.LineJoinMiter solidFillStyle :: AlphaColour Double -> CairoFillStyle solidFillStyle cl = CairoFillStyle fn where fn = c $ setSourceColor cl defaultPointStyle :: CairoPointStyle defaultPointStyle = filledCircles 1 $ opaque white defaultFontStyle :: CairoFontStyle defaultFontStyle = CairoFontStyle { font_name_ = "sans", font_size_ = 10, font_slant_ = C.FontSlantNormal, font_weight_ = C.FontWeightNormal, font_color_ = opaque black } isValidNumber :: (RealFloat a) => a -> Bool isValidNumber v = not (isNaN v) && not (isInfinite v) maybeM :: (Monad m) => b -> (a -> m b) -> Maybe a -> m b maybeM v = maybe (return v) ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''CairoLineStyle ) $( deriveAccessors ''CairoFontStyle ) Chart-0.16/Graphics/Rendering/Chart/Simple/0000755000000000000000000000000012006610042016625 5ustar0000000000000000Chart-0.16/Graphics/Rendering/Chart/Simple/Internal.hs0000644000000000000000000002635712006610042020752 0ustar0000000000000000module Graphics.Rendering.Chart.Simple.Internal where import Data.Maybe ( catMaybes ) import Data.Colour import Data.Colour.Names import Graphics.Rendering.Chart styleColor :: Int -> AlphaColour Double styleColor ind = colorSequence !! ind where colorSequence = cycle $ map opaque [ blue, red, green, yellow , cyan, magenta, black ] styleSymbol :: Int -> PlotKind styleSymbol ind = symbolSequence !! ind where symbolSequence = cycle [ Ex, HollowCircle, Square, Diamond , Triangle, DownTriangle, Plus, Star , FilledCircle ] -- When defaultLayout1 has been generalized, change this signature to -- [InternalPlot x y] -> Layout1 x y z iplot :: [InternalPlot Double Double] -> Layout1 Double Double iplot foobar = defaultLayout1 { layout1_plots_ = concat $ zipWith toplot (ip foobar) [0..] } 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 Left plots where vs = zip xs ys plots = case catMaybes $ map plotas yks of [] -> [ toPlot $ defaultPlotLines { plot_lines_title_ = name yks, plot_lines_values_ = [vs], plot_lines_style_ = solidLine 1 (styleColor ind) } ] xs -> xs plotas Solid = Just $ toPlot $ defaultPlotLines { plot_lines_title_ = name yks, plot_lines_values_ = [vs], plot_lines_style_ = solidLine 1 (styleColor ind) } plotas Dashed = Just $ toPlot $ defaultPlotLines { plot_lines_title_ = name yks, plot_lines_values_ = [vs], plot_lines_style_ = dashedLine 1 [10,10] (styleColor ind) } plotas Dotted = Just $ toPlot $ defaultPlotLines { plot_lines_title_ = name yks, plot_lines_values_ = [vs], plot_lines_style_ = dashedLine 1 [1,11] (styleColor ind) } plotas FilledCircle = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = filledCircles 4 (styleColor ind) } plotas HollowCircle = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = hollowCircles 5 1 (styleColor ind) } plotas Triangle = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = hollowPolygon 7 1 3 False (styleColor ind) } plotas DownTriangle = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = hollowPolygon 7 1 3 True (styleColor ind) } plotas Square = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = hollowPolygon 7 1 4 False (styleColor ind) } plotas Diamond = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = hollowPolygon 7 1 4 True (styleColor ind) } plotas Plus = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = plusses 7 1 (styleColor ind) } plotas Ex = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = exes 7 1 (styleColor ind) } plotas Star = Just $ toPlot $ defaultPlotPoints { plot_points_title_ = name yks, plot_points_values_ = vs, plot_points_style_ = stars 7 1 (styleColor ind) } plotas Symbols = plotas (styleSymbol ind) plotas _ = Nothing 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 x y = IPY [y] [PlotKind] | IPX [x] [PlotKind] newtype Layout1DDD = Layout1DDD { plotLayout :: Layout1 Double Double } instance ToRenderable Layout1DDD where toRenderable = toRenderable . plotLayout uplot :: [UPlot] -> Layout1DDD uplot us = Layout1DDD $ iplot $ nameDoubles $ evalfuncs us where nameDoubles :: [UPlot] -> [InternalPlot Double Double] nameDoubles (X xs: uus) = case grabName uus of (ks,uus') -> IPX (filter isValidNumber xs) ks : nameDoubles uus' nameDoubles (UDoubles xs:uus)= case grabName uus of (ks,uus') -> IPY (filter isValidNumber 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 Layout1DDD where pl args = uplot (reverse args) -- | 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 -- | Save a plot as a png file. plotPNG :: PlotPNGType a => String -> a plotPNG fn = plp fn [] class PlotPNGType t where plp :: FilePath -> [UPlot] -> t instance (PlotArg a, PlotPNGType r) => PlotPNGType (a -> r) where plp fn args = \ a -> plp fn (toUPlot a ++ args) instance PlotPNGType (IO a) where plp fn args = do renderableToPNGFile (toRenderable $ uplot (reverse args)) 640 480 fn return undefined data UPlot = UString String | UDoubles [Double] | UFunction (Double -> Double) | UKind [PlotKind] | X [Double] 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 x = [UFunction (realToFrac . x . realToFrac)] instance (Real a, Real b, Fractional a, Fractional b) => IsPlot (a -> b) where toUPlot' = reverse . concatMap f where f x = [UFunction (realToFrac . x . 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] Chart-0.16/Graphics/Rendering/Chart/Plot/0000755000000000000000000000000012006610042016312 5ustar0000000000000000Chart-0.16/Graphics/Rendering/Chart/Plot/Pie.hs0000644000000000000000000001601112006610042017362 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Pie -- Copyright : (c) Tim Docker 2008 -- License : BSD-style (see chart/COPYRIGHT) -- -- A basic pie chart. -- -- Pie charts are handled different to other plots, in that they -- have their own layout, and can't be composed with other plots. A -- pie chart is rendered with code in the following form: -- -- @ -- values :: [PieItem] -- values = [...] -- layout :: PieLayout -- layout = pie_plot ^: pie_data ^= values -- $ defaultPieLayout -- renderable = toRenderable layout -- @ {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.Pie( PieLayout(..), PieChart(..), PieItem(..), defaultPieLayout, defaultPieChart, defaultPieItem, pie_title, pie_title_style, pie_plot, pie_background, pie_margin, pie_data, pie_colors, pie_label_style, pie_label_line_style, pie_start_angle, pitem_label, pitem_offset, pitem_value, ) where -- original code thanks to Neal Alexander import qualified Graphics.Rendering.Cairo as C import Data.List import Data.Bits import Data.Accessor.Template import Data.Colour import Data.Colour.Names (black, white) import Control.Monad import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Legend import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Grid import Graphics.Rendering.Chart.Plot.Types data PieLayout = PieLayout { pie_title_ :: String, pie_title_style_ :: CairoFontStyle, pie_plot_ :: PieChart, pie_background_ :: CairoFillStyle, pie_margin_ :: Double } data PieChart = PieChart { pie_data_ :: [PieItem], pie_colors_ :: [AlphaColour Double], pie_label_style_ :: CairoFontStyle, pie_label_line_style_ :: CairoLineStyle, pie_start_angle_ :: Double } data PieItem = PieItem { pitem_label_ :: String, pitem_offset_ :: Double, pitem_value_ :: Double } defaultPieChart :: PieChart defaultPieChart = PieChart { pie_data_ = [], pie_colors_ = defaultColorSeq, pie_label_style_ = defaultFontStyle, pie_label_line_style_ = solidLine 1 $ opaque black, pie_start_angle_ = 0 } defaultPieItem :: PieItem defaultPieItem = PieItem "" 0 0 defaultPieLayout :: PieLayout defaultPieLayout = PieLayout { pie_background_ = solidFillStyle $ opaque white, pie_title_ = "", pie_title_style_ = defaultFontStyle{ font_size_ = 15 , font_weight_ = C.FontWeightBold }, pie_plot_ = defaultPieChart, pie_margin_ = 10 } instance ToRenderable PieLayout where toRenderable p = fillBackground (pie_background_ p) ( gridToRenderable $ aboveN [ tval $ addMargins (lm/2,0,0,0) (setPickFn nullPickFn title) , weights (1,1) $ tval $ addMargins (lm,lm,lm,lm) (toRenderable $ pie_plot_ p) ] ) where title = label (pie_title_style_ p) HTA_Centre VTA_Top (pie_title_ p) lm = pie_margin_ p instance ToRenderable PieChart where toRenderable p = Renderable { minsize = minsizePie p, render = renderPie p } extraSpace p = do textSizes <- mapM textSize (map pitem_label_ (pie_data_ p)) let maxw = foldr (max.fst) 0 textSizes let maxh = foldr (max.snd) 0 textSizes let maxo = foldr (max.pitem_offset_) 0 (pie_data_ p) let extra = label_rgap + label_rlength + maxo return (extra + maxw, extra + maxh ) minsizePie p = do (extraw,extrah) <- extraSpace p return (extraw * 2, extrah * 2) renderPie p (w,h) = do (extraw,extrah) <- extraSpace p let (w,h) = (p_x p2 - p_x p1, p_y p2 - p_y p1) let center = Point (p_x p1 + w/2) (p_y p1 + h/2) let radius = (min (w - 2*extraw) (h - 2*extrah)) / 2 foldM_ (paint center radius) (pie_start_angle_ p) (zip (pie_colors_ p) content) return nullPickFn where p1 = Point 0 0 p2 = Point w h content = let total = sum (map pitem_value_ (pie_data_ p)) in [ pi{pitem_value_=pitem_value_ pi/total} | pi <- pie_data_ p ] paint :: Point -> Double -> Double -> (AlphaColour Double, PieItem) -> CRender Double paint center radius a1 (color,pitem) = do let ax = 360.0 * (pitem_value_ pitem) let a2 = a1 + (ax / 2) let a3 = a1 + ax let offset = pitem_offset_ pitem pieSlice (ray a2 offset) a1 a3 color pieLabel (pitem_label_ pitem) a2 offset return a3 where pieLabel :: String -> Double -> Double -> CRender () pieLabel name angle offset = do setFontStyle (pie_label_style_ p) setLineStyle (pie_label_line_style_ p) moveTo (ray angle (radius + label_rgap+offset)) let p1 = ray angle (radius+label_rgap+label_rlength+offset) lineTo p1 (tw,th) <- textSize name let (offset,anchor) = if angle < 90 || angle > 270 then ((0+),HTA_Left) else ((0-),HTA_Right) c $ C.relLineTo (offset (tw + label_rgap)) 0 c $ C.stroke let p2 = p1 `pvadd` (Vector (offset label_rgap) 0) drawText anchor VTA_Bottom p2 name pieSlice :: Point -> Double -> Double -> AlphaColour Double -> CRender () pieSlice (Point x y) a1 a2 color = c $ do C.newPath C.arc x y radius (radian a1) (radian a2) C.lineTo x y C.lineTo x y C.closePath setSourceColor color C.fillPreserve C.setSourceRGBA 1 1 1 0.1 C.stroke ray :: Double -> Double -> Point ray angle r = Point x' y' where x' = x + (cos' * x'') y' = y + (sin' * x'') cos' = (cos . radian) angle sin' = (sin . radian) angle x'' = ((x + r) - x) x = p_x center y = p_y center radian = (*(pi / 180.0)) label_rgap = 5 label_rlength = 15 ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PieLayout ) $( deriveAccessors ''PieChart ) $( deriveAccessors ''PieItem ) Chart-0.16/Graphics/Rendering/Chart/Plot/ErrBars.hs0000644000000000000000000001050612006610042020210 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.ErrBars -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Plot series of points with associated error bars. -- {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.ErrBars( PlotErrBars(..), defaultPlotErrBars, ErrPoint(..), ErrValue(..), symErrPoint, -- * Accessors -- | These accessors are generated by template haskell plot_errbars_title, plot_errbars_line_style, plot_errbars_tick_length, plot_errbars_overhang, plot_errbars_values, ) where import Data.Accessor.Template import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Data.Colour (opaque) import Data.Colour.Names (black, blue) import Data.Colour.SRGB (sRGB) -- | Value for holding a point with associated error bounds for each axis. data ErrValue x = ErrValue { ev_low :: x, ev_best :: x, ev_high :: x } deriving Show data ErrPoint x y = ErrPoint { ep_x :: ErrValue x, ep_y :: ErrValue y } deriving Show -- | When the error is symmetric, we can simply pass in dx for the error. symErrPoint :: (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b symErrPoint x y dx dy = ErrPoint (ErrValue (x-dx) x (x+dx)) (ErrValue (y-dy) y (y+dy)) -- | Value defining a series of error intervals, and a style in -- which to render them. data PlotErrBars x y = PlotErrBars { plot_errbars_title_ :: String, plot_errbars_line_style_ :: CairoLineStyle, plot_errbars_tick_length_ :: Double, plot_errbars_overhang_ :: Double, plot_errbars_values_ :: [ErrPoint x y] } instance ToPlot PlotErrBars where toPlot p = Plot { plot_render_ = renderPlotErrBars p, plot_legend_ = [(plot_errbars_title_ p, renderPlotLegendErrBars p)], plot_all_points_ = ( concat [ [ev_low x,ev_high x] | ErrPoint x _ <- pts ] , concat [ [ev_low y,ev_high y] | ErrPoint _ y <- pts ] ) } where pts = plot_errbars_values_ p renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> CRender () renderPlotErrBars p pmap = preserveCState $ do mapM_ (drawErrBar.epmap) (plot_errbars_values_ p) where epmap (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) = ErrPoint (ErrValue xl' x' xh') (ErrValue yl' y' yh') where (Point x' y') = pmap' (x,y) (Point xl' yl') = pmap' (xl,yl) (Point xh' yh') = pmap' (xh,yh) drawErrBar = drawErrBar0 p pmap' = mapXY pmap drawErrBar0 ps (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) = do let tl = plot_errbars_tick_length_ ps let oh = plot_errbars_overhang_ ps setLineStyle (plot_errbars_line_style_ ps) c $ C.newPath c $ C.moveTo (xl-oh) y c $ C.lineTo (xh+oh) y c $ C.moveTo x (yl-oh) c $ C.lineTo x (yh+oh) c $ C.moveTo xl (y-tl) c $ C.lineTo xl (y+tl) c $ C.moveTo (x-tl) yl c $ C.lineTo (x+tl) yl c $ C.moveTo xh (y-tl) c $ C.lineTo xh (y+tl) c $ C.moveTo (x-tl) yh c $ C.lineTo (x+tl) yh c $ C.stroke renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> CRender () renderPlotLegendErrBars p r@(Rect p1 p2) = preserveCState $ do drawErrBar (symErrPoint (p_x p1) ((p_y p1 + p_y p2)/2) dx dx) drawErrBar (symErrPoint ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2) dx dx) drawErrBar (symErrPoint (p_x p2) ((p_y p1 + p_y p2)/2) dx dx) where drawErrBar = drawErrBar0 p dx = min ((p_x p2 - p_x p1)/6) ((p_y p2 - p_y p1)/2) defaultPlotErrBars :: PlotErrBars x y defaultPlotErrBars = PlotErrBars { plot_errbars_title_ = "", plot_errbars_line_style_ = solidLine 1 $ opaque blue, plot_errbars_tick_length_ = 3, plot_errbars_overhang_ = 0, plot_errbars_values_ = [] } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PlotErrBars ) Chart-0.16/Graphics/Rendering/Chart/Plot/Hidden.hs0000644000000000000000000000234712006610042020047 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Hidden -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Plots that don't show, but occupy space so as to effect axis -- scaling -- {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.Hidden( PlotHidden(..), ) where import Data.Accessor.Template import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types -- | Value defining some hidden x and y values. The values don't -- get displayed, but still affect axis scaling. data PlotHidden x y = PlotHidden { plot_hidden_x_values_ :: [x], plot_hidden_y_values_ :: [y] } instance ToPlot PlotHidden where toPlot ph = Plot { plot_render_ = \_ -> return (), plot_legend_ = [], plot_all_points_ = (plot_hidden_x_values_ ph, plot_hidden_y_values_ ph) } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PlotHidden ) Chart-0.16/Graphics/Rendering/Chart/Plot/Candle.hs0000644000000000000000000001375612006610042020050 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Candle -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Candlestick charts for financial plotting -- {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.Candle( PlotCandle(..), Candle(..), defaultPlotCandle, plot_candle_title, plot_candle_line_style, plot_candle_tick_length, plot_candle_width, plot_candle_centre, plot_candle_fill, plot_candle_rise_fill_style, plot_candle_fall_fill_style, plot_candle_values, ) where import Data.Accessor.Template import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Control.Monad import Data.Colour (opaque) import Data.Colour.Names (black, white, blue) import Data.Colour.SRGB (sRGB) -- | Value defining a financial interval: opening and closing prices, with -- maxima and minima; and a style in which to render them. -- By convention, there are different fill styles depending on whether -- the price rises (open < close) or falls (close < open). -- (This plot type can also be re-purposed for statistical intervals, e.g. -- minimum, first quartile, median, third quartile, maximum.) data PlotCandle x y = PlotCandle { plot_candle_title_ :: String, plot_candle_line_style_ :: CairoLineStyle, plot_candle_fill_ :: Bool, plot_candle_rise_fill_style_ :: CairoFillStyle, plot_candle_fall_fill_style_ :: CairoFillStyle, plot_candle_tick_length_ :: Double, plot_candle_width_ :: Double, plot_candle_centre_ :: Double, plot_candle_values_ :: [Candle x y] } -- | A Value holding price intervals for a given x-coord. -- An alternative view is that these are statistical intervals: the -- 0th, 25th, 50th, 75th, and 100th percentiles. data Candle x y = Candle { candle_x :: x , candle_low :: y , candle_open :: y , candle_mid :: y , candle_close :: y , candle_high :: y } deriving (Show) instance ToPlot PlotCandle where toPlot p = Plot { plot_render_ = renderPlotCandle p, plot_legend_ = [(plot_candle_title_ p, renderPlotLegendCandle p)], plot_all_points_ = ( map candle_x pts , concat [ [candle_low c, candle_high c] | c <- pts ] ) } where pts = plot_candle_values_ p renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> CRender () renderPlotCandle p pmap = preserveCState $ do mapM_ (drawCandle p . candlemap) (plot_candle_values_ p) where candlemap (Candle x lo op mid cl hi) = Candle x' lo' op' mid' cl' hi' where (Point x' mid') = pmap' (x,mid) (Point _ lo') = pmap' (x,lo) (Point _ op') = pmap' (x,op) (Point _ cl') = pmap' (x,cl) (Point _ hi') = pmap' (x,hi) pmap' = mapXY pmap drawCandle ps (Candle x lo open mid close hi) = do let tl = plot_candle_tick_length_ ps let wd = plot_candle_width_ ps let ct = plot_candle_centre_ ps let f = plot_candle_fill_ ps -- the pixel coordinate system is inverted wrt the value coords. when f $ do setFillStyle (if open >= close then plot_candle_rise_fill_style_ ps else plot_candle_fall_fill_style_ ps) c $ C.newPath c $ C.moveTo (x-wd) open c $ C.lineTo (x-wd) close c $ C.lineTo (x+wd) close c $ C.lineTo (x+wd) open c $ C.lineTo (x-wd) open c $ C.fill setLineStyle (plot_candle_line_style_ ps) c $ C.newPath c $ C.moveTo (x-wd) open c $ C.lineTo (x-wd) close c $ C.lineTo (x+wd) close c $ C.lineTo (x+wd) open c $ C.lineTo (x-wd) open c $ C.stroke c $ C.newPath c $ C.moveTo x (min lo hi) c $ C.lineTo x (min open close) c $ C.moveTo x (max open close) c $ C.lineTo x (max hi lo) c $ C.stroke when (tl > 0) $ do c $ C.newPath c $ C.moveTo (x-tl) lo c $ C.lineTo (x+tl) lo c $ C.moveTo (x-tl) hi c $ C.lineTo (x+tl) hi c $ C.stroke when (ct > 0) $ do c $ C.moveTo (x-ct) mid c $ C.lineTo (x+ct) mid c $ C.stroke renderPlotLegendCandle :: PlotCandle x y -> Rect -> CRender () renderPlotLegendCandle p r@(Rect p1 p2) = preserveCState $ do drawCandle p{ plot_candle_width_ = 2} (Candle ((p_x p1 + p_x p2)*1/4) lo open mid close hi) drawCandle p{ plot_candle_width_ = 2} (Candle ((p_x p1 + p_x p2)*2/3) lo close mid open hi) where lo = max (p_y p1) (p_y p2) mid = (p_y p1 + p_y p2)/2 hi = min (p_y p1) (p_y p2) open = (lo + mid) / 2 close = (mid + hi) / 2 defaultPlotCandle :: PlotCandle x y defaultPlotCandle = PlotCandle { plot_candle_title_ = "", plot_candle_line_style_ = solidLine 1 $ opaque blue, plot_candle_fill_ = False, plot_candle_rise_fill_style_ = solidFillStyle $ opaque white, plot_candle_fall_fill_style_ = solidFillStyle $ opaque blue, plot_candle_tick_length_ = 2, plot_candle_width_ = 5, plot_candle_centre_ = 0, plot_candle_values_ = [] } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PlotCandle ) Chart-0.16/Graphics/Rendering/Chart/Plot/Bars.hs0000644000000000000000000001742212006610042017543 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Bars -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Bar Charts -- {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.Bars( PlotBars(..), defaultPlotBars, PlotBarsStyle(..), PlotBarsSpacing(..), PlotBarsAlignment(..), BarsPlotValue(..), plotBars, plot_bars_style, plot_bars_item_styles, plot_bars_titles, plot_bars_spacing, plot_bars_alignment, plot_bars_reference, plot_bars_singleton_width, plot_bars_values, ) where import Data.Accessor.Template import Control.Monad import Data.List(nub,sort) import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Graphics.Rendering.Chart.Axis import Data.Colour (opaque) import Data.Colour.Names (black, blue) import Data.Colour.SRGB (sRGB) class PlotValue a => BarsPlotValue a where barsReference :: a barsAdd :: a -> a -> a instance BarsPlotValue Double where barsReference = 0 barsAdd = (+) instance BarsPlotValue Int where barsReference = 0 barsAdd = (+) data PlotBarsStyle = BarsStacked -- ^ Bars for a fixed x are stacked vertically -- on top of each other. | BarsClustered -- ^ Bars for a fixed x are put horizontally -- beside each other. deriving (Show) data PlotBarsSpacing = BarsFixWidth Double -- ^ All bars have the same width in pixels. | BarsFixGap Double Double -- ^ (BarsFixGap g mw) means make the gaps between -- the bars equal to g, but with a minimum bar width -- of mw deriving (Show) -- | How bars for a given (x,[y]) are aligned with respect to screen -- coordinate corresponding to x (deviceX). data PlotBarsAlignment = BarsLeft -- ^ The left edge of bars is at deviceX | BarsCentered -- ^ The right edge of bars is at deviceX | BarsRight -- ^ Bars are centered around deviceX deriving (Show) -- | Value describing how to plot a set of bars. -- Note that the input data is typed [(x,[y])], ie for each x value -- we plot several y values. Typically the size of each [y] list would -- be the same. data PlotBars x y = PlotBars { -- | This value specifies whether each value from [y] should be -- shown beside or above the previous value. plot_bars_style_ :: PlotBarsStyle, -- | The style in which to draw each element of [y]. A fill style -- is required, and if a linestyle is given, each bar will be -- outlined. plot_bars_item_styles_ :: [ (CairoFillStyle,Maybe CairoLineStyle) ], -- | The title of each element of [y]. These will be shown in the legend. plot_bars_titles_ :: [String], -- | This value controls how the widths of the bars are -- calculated. Either the widths of the bars, or the gaps between -- them can be fixed. plot_bars_spacing_ :: PlotBarsSpacing, -- | This value controls how bars for a fixed x are aligned with -- respect to the device coordinate corresponding to x. plot_bars_alignment_ :: PlotBarsAlignment, -- | The starting level for the chart (normally 0). plot_bars_reference_ :: y, plot_bars_singleton_width_ :: Double, -- | The actual points to be plotted. plot_bars_values_ :: [ (x,[y]) ] } defaultPlotBars :: BarsPlotValue y => PlotBars x y defaultPlotBars = PlotBars { plot_bars_style_ = BarsClustered, plot_bars_item_styles_ = cycle istyles, plot_bars_titles_ = [], plot_bars_spacing_ = BarsFixGap 10 2, plot_bars_alignment_ = BarsCentered, plot_bars_values_ = [], plot_bars_singleton_width_ = 20, plot_bars_reference_ = barsReference } where istyles = map mkstyle defaultColorSeq mkstyle c = (solidFillStyle c, Just (solidLine 1.0 $ opaque black)) plotBars :: (BarsPlotValue y) => PlotBars x y -> Plot x y plotBars p = Plot { plot_render_ = renderPlotBars p, plot_legend_ = zip (plot_bars_titles_ p) (map renderPlotLegendBars (plot_bars_item_styles_ p)), plot_all_points_ = allBarPoints p } renderPlotBars :: (BarsPlotValue y) => PlotBars x y -> PointMapFn x y -> CRender () renderPlotBars p pmap = case (plot_bars_style_ p) of BarsClustered -> forM_ vals clusteredBars BarsStacked -> forM_ vals stackedBars where clusteredBars (x,ys) = preserveCState $ do forM_ (zip3 [0,1..] ys styles) $ \(i, y, (fstyle,_)) -> do setFillStyle fstyle fillPath (barPath (offset i) x yref0 y) c $ C.fill forM_ (zip3 [0,1..] ys styles) $ \(i, y, (_,mlstyle)) -> do whenJust mlstyle $ \lstyle -> do setLineStyle lstyle strokePath (barPath (offset i) x yref0 y) offset = case (plot_bars_alignment_ p) of BarsLeft -> \i -> fromIntegral i * width BarsRight -> \i -> fromIntegral (i-nys) * width BarsCentered -> \i -> fromIntegral (2*i-nys) * width/2 stackedBars (x,ys) = preserveCState $ do let y2s = zip (yref0:stack ys) (stack ys) let ofs = case (plot_bars_alignment_ p) of { BarsLeft -> 0 ; BarsRight -> (-width) ; BarsCentered -> (-width/2) } forM_ (zip y2s styles) $ \((y0,y1), (fstyle,_)) -> do setFillStyle fstyle fillPath (barPath ofs x y0 y1) forM_ (zip y2s styles) $ \((y0,y1), (_,mlstyle)) -> do whenJust mlstyle $ \lstyle -> do setLineStyle lstyle strokePath (barPath ofs x y0 y1) barPath xos x y0 y1 = do let (Point x' y') = pmap' (x,y1) let (Point _ y0') = pmap' (x,y0) rectPath (Rect (Point (x'+xos) y0') (Point (x'+xos+width) y')) yref0 = plot_bars_reference_ p vals = plot_bars_values_ p width = case plot_bars_spacing_ p of BarsFixGap gap minw -> let w = max (minXInterval - gap) minw in case (plot_bars_style_ p) of BarsClustered -> w / fromIntegral nys BarsStacked -> w BarsFixWidth width -> width styles = plot_bars_item_styles_ p minXInterval = let diffs = zipWith (-) (tail mxs) mxs in if null diffs then plot_bars_singleton_width_ p else minimum diffs where xs = fst (allBarPoints p) mxs = nub $ sort $ map mapX xs nys = maximum [ length ys | (x,ys) <- vals ] pmap' = mapXY pmap mapX x = p_x (pmap' (x,barsReference)) whenJust :: (Monad m) => Maybe a -> (a -> m ()) -> m () whenJust (Just a) f = f a whenJust _ _ = return () allBarPoints :: (BarsPlotValue y) => PlotBars x y -> ([x],[y]) allBarPoints p = case (plot_bars_style_ p) of BarsClustered -> ( [x| (x,_) <- pts], y0:concat [ys| (_,ys) <- pts] ) BarsStacked -> ( [x| (x,_) <- pts], y0:concat [stack ys | (_,ys) <- pts] ) where pts = plot_bars_values_ p y0 = plot_bars_reference_ p stack :: (BarsPlotValue y) => [y] -> [y] stack ys = scanl1 barsAdd ys renderPlotLegendBars :: (CairoFillStyle,Maybe CairoLineStyle) -> Rect -> CRender () renderPlotLegendBars (fstyle,mlstyle) r@(Rect p1 p2) = do setFillStyle fstyle fillPath (rectPath r) ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PlotBars ) Chart-0.16/Graphics/Rendering/Chart/Plot/Lines.hs0000644000000000000000000000665312006610042017732 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Lines -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Line plots -- {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.Lines( PlotLines(..), defaultPlotLines, defaultPlotLineStyle, hlinePlot, vlinePlot, plot_lines_title, plot_lines_style, plot_lines_values, plot_lines_limit_values, ) where import Data.Accessor.Template import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Data.Colour (opaque) import Data.Colour.Names (black, blue) -- | Value defining a series of (possibly disjointed) lines, -- and a style in which to render them. data PlotLines x y = PlotLines { plot_lines_title_ :: String, plot_lines_style_ :: CairoLineStyle, -- | The lines to be plotted plot_lines_values_ :: [[(x,y)]], -- | Additional lines to be plotted, specified using -- the Limit type to allow referencing the edges of -- the plot area. plot_lines_limit_values_ :: [[(Limit x, Limit y)]] } instance ToPlot PlotLines where toPlot p = Plot { plot_render_ = renderPlotLines p, plot_legend_ = [(plot_lines_title_ p, renderPlotLegendLines p)], plot_all_points_ = ( map fst pts ++ xs, map snd pts ++ ys ) } where pts = concat (plot_lines_values_ p) xs = [ x | (LValue x,_) <- concat (plot_lines_limit_values_ p)] ys = [ y | (_,LValue y) <- concat (plot_lines_limit_values_ p)] renderPlotLines :: PlotLines x y -> PointMapFn x y -> CRender () renderPlotLines p pmap = preserveCState $ do setLineStyle (plot_lines_style_ p) mapM_ (drawLines (mapXY pmap)) (plot_lines_values_ p) mapM_ (drawLines pmap) (plot_lines_limit_values_ p) where drawLines mapfn pts = strokePath (map mapfn pts) renderPlotLegendLines :: PlotLines x y -> Rect -> CRender () renderPlotLegendLines p r@(Rect p1 p2) = preserveCState $ do setLineStyle (plot_lines_style_ p) let y = (p_y p1 + p_y p2) / 2 strokePath [Point (p_x p1) y, Point (p_x p2) y] defaultPlotLineStyle :: CairoLineStyle defaultPlotLineStyle = (solidLine 1 $ opaque blue){ line_cap_ = C.LineCapRound, line_join_ = C.LineJoinRound } defaultPlotLines :: PlotLines x y defaultPlotLines = PlotLines { plot_lines_title_ = "", plot_lines_style_ = defaultPlotLineStyle, plot_lines_values_ = [], plot_lines_limit_values_ = [] } -- | Helper function to plot a single horizontal line. hlinePlot :: String -> CairoLineStyle -> b -> Plot a b hlinePlot t ls v = toPlot defaultPlotLines { plot_lines_title_ = t, plot_lines_style_ = ls, plot_lines_limit_values_ = [[(LMin, LValue v),(LMax, LValue v)]] } -- | Helper function to plot a single vertical line. vlinePlot :: String -> CairoLineStyle -> a -> Plot a b vlinePlot t ls v = toPlot defaultPlotLines { plot_lines_title_ = t, plot_lines_style_ = ls, plot_lines_limit_values_ = [[(LValue v,LMin),(LValue v,LMax)]] } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PlotLines ) Chart-0.16/Graphics/Rendering/Chart/Plot/FillBetween.hs0000644000000000000000000000540712006610042021054 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.FillBetween -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Plots that fill the area between two lines. -- {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.FillBetween( PlotFillBetween(..), defaultPlotFillBetween, -- * Accessors -- | These accessors are generated by template haskell plot_fillbetween_title, plot_fillbetween_style, plot_fillbetween_values, ) where import Data.Accessor.Template import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Data.Colour (opaque) import Data.Colour.Names (black, blue) import Data.Colour.SRGB (sRGB) -- | Value specifying a plot filling the area between two sets of Y -- coordinates, given common X coordinates. data PlotFillBetween x y = PlotFillBetween { plot_fillbetween_title_ :: String, plot_fillbetween_style_ :: CairoFillStyle, plot_fillbetween_values_ :: [ (x, (y,y))] } instance ToPlot PlotFillBetween where toPlot p = Plot { plot_render_ = renderPlotFillBetween p, plot_legend_ = [(plot_fillbetween_title_ p,renderPlotLegendFill p)], plot_all_points_ = plotAllPointsFillBetween p } renderPlotFillBetween :: PlotFillBetween x y -> PointMapFn x y -> CRender () renderPlotFillBetween p pmap = renderPlotFillBetween' p (plot_fillbetween_values_ p) pmap renderPlotFillBetween' p [] _ = return () renderPlotFillBetween' p vs pmap = preserveCState $ do setFillStyle (plot_fillbetween_style_ p) fillPath ([p0] ++ p1s ++ reverse p2s ++ [p0]) where pmap' = mapXY pmap (p0:p1s) = map pmap' [ (x,y1) | (x,(y1,y2)) <- vs ] p2s = map pmap' [ (x,y2) | (x,(y1,y2)) <- vs ] renderPlotLegendFill :: PlotFillBetween x y -> Rect -> CRender () renderPlotLegendFill p r = preserveCState $ do setFillStyle (plot_fillbetween_style_ p) fillPath (rectPath r) plotAllPointsFillBetween :: PlotFillBetween x y -> ([x],[y]) plotAllPointsFillBetween p = ( [ x | (x,(_,_)) <- pts ] , concat [ [y1,y2] | (_,(y1,y2)) <- pts ] ) where pts = plot_fillbetween_values_ p defaultPlotFillBetween :: PlotFillBetween x y defaultPlotFillBetween = PlotFillBetween { plot_fillbetween_title_ = "", plot_fillbetween_style_ = solidFillStyle (opaque $ sRGB 0.5 0.5 1.0), plot_fillbetween_values_ = [] } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PlotFillBetween ) Chart-0.16/Graphics/Rendering/Chart/Plot/Annotation.hs0000644000000000000000000000531512006610042020764 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Annotation -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Show textual annotations on a chart. {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.Annotation( PlotAnnotation(..), defaultPlotAnnotation, plot_annotation_hanchor, plot_annotation_vanchor, plot_annotation_angle, plot_annotation_style, plot_annotation_values ) where import Data.Accessor.Template import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Data.Colour (opaque) import Data.Colour.Names (black, blue) import Data.Colour.SRGB (sRGB) -- | Value for describing a series of text annotations -- to be placed at arbitrary points on the graph. Annotations -- can be rotated and styled. Rotation angle is given in degrees, -- rotation is performend around the anchor point. data PlotAnnotation x y = PlotAnnotation { plot_annotation_hanchor_ :: HTextAnchor, plot_annotation_vanchor_ :: VTextAnchor, plot_annotation_angle_ :: Double, plot_annotation_style_ :: CairoFontStyle, plot_annotation_values_ :: [(x,y,String)] } instance ToPlot PlotAnnotation where toPlot p = Plot { plot_render_ = renderAnnotation p, plot_legend_ = [], plot_all_points_ = (map (\(x,_,_)->x) vs , map (\(_,y,_)->y) vs) } where vs = plot_annotation_values_ p renderAnnotation :: PlotAnnotation x y -> PointMapFn x y -> CRender () renderAnnotation p pMap = preserveCState $ do setFontStyle style mapM_ drawOne values where hta = plot_annotation_hanchor_ p vta = plot_annotation_vanchor_ p values = plot_annotation_values_ p angle = plot_annotation_angle_ p style = plot_annotation_style_ p drawOne (x,y,s) = drawTextsR hta vta angle point s where point = pMap (LValue x, LValue y) defaultPlotAnnotation = PlotAnnotation { plot_annotation_hanchor_ = HTA_Centre, plot_annotation_vanchor_ = VTA_Centre, plot_annotation_angle_ = 0, plot_annotation_style_ = defaultFontStyle, plot_annotation_values_ = [] } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PlotAnnotation ) Chart-0.16/Graphics/Rendering/Chart/Plot/Points.hs0000644000000000000000000000453112006610042020125 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Points -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Functions to plot sets of points, marked in various styles. {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.Points( PlotPoints(..), defaultPlotPoints, -- * Accessors -- | These accessors are generated by template haskell plot_points_title, plot_points_style, plot_points_values, ) where import Data.Accessor.Template import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Plot.Types import Data.Colour (opaque) import Data.Colour.Names (black, blue) -- | Value defining a series of datapoints, and a style in -- which to render them. data PlotPoints x y = PlotPoints { plot_points_title_ :: String, plot_points_style_ :: CairoPointStyle, plot_points_values_ :: [(x,y)] } instance ToPlot PlotPoints where toPlot p = Plot { plot_render_ = renderPlotPoints p, plot_legend_ = [(plot_points_title_ p, renderPlotLegendPoints p)], plot_all_points_ = (map fst pts, map snd pts) } where pts = plot_points_values_ p renderPlotPoints :: PlotPoints x y -> PointMapFn x y -> CRender () renderPlotPoints p pmap = preserveCState $ do mapM_ (drawPoint.pmap') (plot_points_values_ p) where pmap' = mapXY pmap (CairoPointStyle drawPoint) = (plot_points_style_ p) renderPlotLegendPoints :: PlotPoints x y -> Rect -> CRender () renderPlotLegendPoints p r@(Rect p1 p2) = preserveCState $ do drawPoint (Point (p_x p1) ((p_y p1 + p_y p2)/2)) drawPoint (Point ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2)) drawPoint (Point (p_x p2) ((p_y p1 + p_y p2)/2)) where (CairoPointStyle drawPoint) = (plot_points_style_ p) defaultPlotPoints :: PlotPoints x y defaultPlotPoints = PlotPoints { plot_points_title_ = "", plot_points_style_ = defaultPointStyle, plot_points_values_ = [] } ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''PlotPoints ) Chart-0.16/Graphics/Rendering/Chart/Plot/Types.hs0000644000000000000000000000500012006610042017745 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Plot.Types -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Datatypes and functions common to the implementation of the various -- plot types. -- {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.Types( Plot(..), joinPlot, ToPlot(..), mapXY, plot_render, plot_legend, plot_all_points, ) where import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Control.Monad import Data.Accessor.Template import Data.Colour import Data.Colour.Names -- | Interface to control plotting on a 2D area. data Plot x y = Plot { -- | Given the mapping between model space coordinates and device -- coordinates, render this plot into a chart. plot_render_ :: PointMapFn x y -> CRender (), -- | Details for how to show this plot in a legend. For each item -- the string is the text to show, and the function renders a -- graphical sample of the plot. plot_legend_ :: [ (String, Rect -> CRender ()) ], -- | All of the model space coordinates to be plotted. These are -- used to autoscale the axes where necessary. plot_all_points_ :: ([x],[y]) } -- | A type class abstracting the conversion of a value to a Plot. class ToPlot a where toPlot :: a x y -> Plot x y -- | Join any two plots together (they will share a legend). joinPlot :: Plot x y -> Plot x y -> Plot x y joinPlot Plot{ plot_render_ = renderP , plot_legend_ = legendP , plot_all_points_ = (xsP,ysP) } Plot{ plot_render_ = renderQ , plot_legend_ = legendQ , plot_all_points_ = (xsQ,ysQ) } = Plot{ plot_render_ = \a-> renderP a >> renderQ a , plot_legend_ = legendP ++ legendQ , plot_all_points_ = ( xsP++xsQ, ysP++ysQ ) } ---------------------------------------------------------------------- mapXY :: PointMapFn x y -> ((x,y) -> Point) mapXY f (x,y) = f (LValue x, LValue y) ---------------------------------------------------------------------- ---------------------------------------------------------------------- ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor -- for each field. $( deriveAccessors ''Plot ) Chart-0.16/Graphics/Rendering/Chart/Plot/AreaSpots.hs0000644000000000000000000002113112006610042020545 0ustar0000000000000000-- | -- Module : Graphics.Rendering.Chart.Plot.AreaSpots -- Copyright : (c) Malcolm Wallace 2009 -- License : BSD-style (see COPYRIGHT file) -- -- Area spots are a collection of unconnected filled circles, -- with x,y position, and an independent z value to be represented -- by the relative area of the spots. {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Plot.AreaSpots ( AreaSpots(..) , defaultAreaSpots , area_spots_title , area_spots_linethick , area_spots_linecolour , area_spots_fillcolour , area_spots_max_radius , area_spots_values , AreaSpots4D(..) , defaultAreaSpots4D , area_spots_4d_title , area_spots_4d_linethick , area_spots_4d_palette , area_spots_4d_max_radius , area_spots_4d_values ) where import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Plot.Types import Graphics.Rendering.Chart.Axis import Data.Accessor.Template import Data.Colour import Data.Colour.Names import Control.Monad -- stuff that belongs in Data.Tuple fst3 (a,_,_) = a snd3 (_,a,_) = a thd3 (_,_,a) = a fst4 (a,_,_,_) = a snd4 (_,a,_,_) = a thd4 (_,_,a,_) = a fth4 (_,_,_,a) = a -- | A collection of unconnected spots, with x,y position, and an -- independent z value to be represented by the area of the spot. data AreaSpots z x y = AreaSpots { area_spots_title_ :: String , area_spots_linethick_ :: Double , area_spots_linecolour_ :: AlphaColour Double , area_spots_fillcolour_ :: Colour Double , area_spots_opacity_ :: Double , area_spots_max_radius_ :: Double -- ^ the largest size of spot , area_spots_values_ :: [(x,y,z)] } defaultAreaSpots :: AreaSpots z x y defaultAreaSpots = AreaSpots { area_spots_title_ = "" , area_spots_linethick_ = 0.1 , area_spots_linecolour_ = opaque blue , area_spots_fillcolour_ = blue , area_spots_opacity_ = 0.2 , area_spots_max_radius_ = 20 -- in pixels , area_spots_values_ = [] } instance (PlotValue z) => ToPlot (AreaSpots z) where toPlot p = Plot { plot_render_ = renderAreaSpots p , plot_legend_ = [(area_spots_title_ p, renderSpotLegend p)] , plot_all_points_ = ( map fst3 (area_spots_values_ p) , map snd3 (area_spots_values_ p) ) } renderAreaSpots :: (PlotValue z) => AreaSpots z x y -> PointMapFn x y -> CRender () renderAreaSpots p pmap = preserveCState $ forM_ (scaleMax ((area_spots_max_radius_ p)^2) (area_spots_values_ p)) (\ (x,y,z)-> do let radius = sqrt z let (CairoPointStyle drawSpotAt) = filledCircles radius $ flip withOpacity (area_spots_opacity_ p) $ area_spots_fillcolour_ p drawSpotAt (pmap (LValue x, LValue y)) let (CairoPointStyle drawOutlineAt) = hollowCircles radius (area_spots_linethick_ p) (area_spots_linecolour_ p) drawOutlineAt (pmap (LValue x, LValue y)) ) where scaleMax :: PlotValue z => Double -> [(x,y,z)] -> [(x,y,Double)] scaleMax n points = let largest = maximum (map (toValue . thd3) points) scale v = n * toValue v / largest in map (\ (x,y,z) -> (x,y, scale z)) points renderSpotLegend :: AreaSpots z x y -> Rect -> CRender () renderSpotLegend p r@(Rect p1 p2) = preserveCState $ do let radius = min (abs (p_y p1 - p_y p2)) (abs (p_x p1 - p_x p2)) centre = linearInterpolate p1 p2 let (CairoPointStyle drawSpotAt) = filledCircles radius $ flip withOpacity (area_spots_opacity_ p) $ area_spots_fillcolour_ p drawSpotAt centre let (CairoPointStyle drawOutlineAt) = hollowCircles radius (area_spots_linethick_ p) (area_spots_linecolour_ p) drawOutlineAt centre where linearInterpolate (Point x0 y0) (Point x1 y1) = Point (x0 + abs(x1-x0)/2) (y0 + abs(y1-y0)/2) -- | A collection of unconnected spots, with x,y position, an -- independent z value to be represented by the area of the spot, -- and in addition, a fourth variable t to be represented by a colour -- from a given palette. (A linear transfer function from t to palette -- is assumed.) data AreaSpots4D z t x y = AreaSpots4D { area_spots_4d_title_ :: String , area_spots_4d_linethick_ :: Double , area_spots_4d_palette_ :: [Colour Double] , area_spots_4d_opacity_ :: Double , area_spots_4d_max_radius_ :: Double -- ^ the largest size of spot , area_spots_4d_values_ :: [(x,y,z,t)] } defaultAreaSpots4D :: AreaSpots4D z t x y defaultAreaSpots4D = AreaSpots4D { area_spots_4d_title_ = "" , area_spots_4d_linethick_ = 0.1 , area_spots_4d_palette_ = [ blue, green, yellow, orange, red ] , area_spots_4d_opacity_ = 0.2 , area_spots_4d_max_radius_ = 20 -- in pixels , area_spots_4d_values_ = [] } instance (PlotValue z, PlotValue t, Show t) => ToPlot (AreaSpots4D z t) where toPlot p = Plot { plot_render_ = renderAreaSpots4D p , plot_legend_ = [ (area_spots_4d_title_ p , renderSpotLegend4D p) ] , plot_all_points_ = ( map fst4 (area_spots_4d_values_ p) , map snd4 (area_spots_4d_values_ p) ) } renderAreaSpots4D :: (PlotValue z, PlotValue t, Show t) => AreaSpots4D z t x y -> PointMapFn x y -> CRender () renderAreaSpots4D p pmap = preserveCState $ forM_ (scaleMax ((area_spots_4d_max_radius_ p)^2) (length (area_spots_4d_palette_ p)) (area_spots_4d_values_ p)) (\ (x,y,z,t)-> do let radius = sqrt z let colour = (area_spots_4d_palette_ p) !! t let (CairoPointStyle drawSpotAt) = filledCircles radius $ flip withOpacity (area_spots_4d_opacity_ p) $ colour drawSpotAt (pmap (LValue x, LValue y)) let (CairoPointStyle drawOutlineAt) = hollowCircles radius (area_spots_4d_linethick_ p) (opaque colour) drawOutlineAt (pmap (LValue x, LValue y)) ) where scaleMax :: (PlotValue z, PlotValue t, Show t) => Double -> Int -> [(x,y,z,t)] -> [(x,y,Double,Int)] scaleMax n c points = let largest = maximum (map (toValue . thd4) points) scale v = n * toValue v / largest colVals = map (toValue . fth4) points colMin = minimum colVals colMax = maximum colVals select t = min (c-1) $ truncate ( fromIntegral c * (toValue t-colMin) / (colMax-colMin)) in map (\ (x,y,z,t) -> (x,y, scale z, select t)) points renderSpotLegend4D :: AreaSpots4D z t x y -> Rect -> CRender () renderSpotLegend4D p r@(Rect p1 p2) = preserveCState $ do let radius = min (abs (p_y p1 - p_y p2)) (abs (p_x p1 - p_x p2)) centre = linearInterpolate p1 p2 let (CairoPointStyle drawSpotAt) = filledCircles radius $ flip withOpacity (area_spots_4d_opacity_ p) $ head $ area_spots_4d_palette_ p drawSpotAt centre let (CairoPointStyle drawOutlineAt) = hollowCircles radius (area_spots_4d_linethick_ p) (opaque $ head (area_spots_4d_palette_ p)) drawOutlineAt centre where linearInterpolate (Point x0 y0) (Point x1 y1) = Point (x0 + abs(x1-x0)/2) (y0 + abs(y1-y0)/2) ------------------------------------------------------------------------- -- Template haskell to derive Data.Accessor.Accessor $( deriveAccessors ''AreaSpots ) $( deriveAccessors ''AreaSpots4D ) Chart-0.16/Graphics/Rendering/Chart/Axis/0000755000000000000000000000000012006610042016300 5ustar0000000000000000Chart-0.16/Graphics/Rendering/Chart/Axis/Indexed.hs0000644000000000000000000000327112006610042020217 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Unit -- Copyright : (c) Tim Docker 2010 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render indexed axes {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Axis.Indexed( PlotIndex(..), autoIndexAxis, addIndexes, ) where import Graphics.Rendering.Chart.Axis.Types -- | Type for capturing values plotted by index number -- (ie position in a list) rather than a numerical value. newtype PlotIndex = PlotIndex { plotindex_i :: Int } deriving (Eq,Ord,Enum,Num,Real,Integral,Show) instance PlotValue PlotIndex where toValue (PlotIndex i) = fromIntegral i fromValue = PlotIndex . round autoAxis = autoIndexAxis [] -- | Augment a list of values with index numbers for plotting. addIndexes :: [a] -> [(PlotIndex,a)] addIndexes as = map (\(i,a) -> (PlotIndex i,a)) (zip [0..] as) -- | Create an axis for values indexed by position. The -- list of strings are the labels to be used. autoIndexAxis :: Integral i => [String] -> [i] -> AxisData i autoIndexAxis labels vs = AxisData { axis_viewport_ = vport, axis_tropweiv_ = invport, axis_ticks_ = [], axis_labels_ = [filter (\(i,l) -> i >= imin && i <= imax) (zip [0..] labels)], axis_grid_ = [] } where vport r i = linMap id ( fromIntegral imin - 0.5 , fromIntegral imax + 0.5) r (fromIntegral i) invport r z = invLinMap round fromIntegral (imin, imax) r z imin = minimum vs imax = maximum vs Chart-0.16/Graphics/Rendering/Chart/Axis/Unit.hs0000644000000000000000000000143112006610042017552 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Unit -- Copyright : (c) Tim Docker 2010 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render unit indexed axes {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Axis.Unit( unitAxis, ) where import Graphics.Rendering.Chart.Axis.Types instance PlotValue () where toValue () = 0 fromValue = const () autoAxis = const unitAxis unitAxis :: AxisData () unitAxis = AxisData { axis_viewport_ = \(x0,x1) _ -> (x0+x1)/2, axis_tropweiv_ = \_ _ -> (), axis_ticks_ = [((), 0)], axis_labels_ = [[((), "")]], axis_grid_ = [] } Chart-0.16/Graphics/Rendering/Chart/Axis/LocalTime.hs0000644000000000000000000003007412006610042020511 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.LocalTime -- Copyright : (c) Tim Docker 2010 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render time axes {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Axis.LocalTime( timeAxis, autoTimeAxis, days, months, years ) where import qualified Graphics.Rendering.Cairo as C import Data.Time import Data.Fixed import System.Locale (defaultTimeLocale) import Control.Monad import Data.List import Data.Accessor.Template import Data.Colour (opaque) import Data.Colour.Names (black, lightgrey) import Data.Ord (comparing) import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable import Graphics.Rendering.Chart.Axis.Types instance PlotValue LocalTime where toValue = doubleFromLocalTime fromValue = localTimeFromDouble autoAxis = autoTimeAxis ---------------------------------------------------------------------- -- | Map a LocalTime value to a plot coordinate. doubleFromLocalTime :: LocalTime -> Double doubleFromLocalTime lt = fromIntegral (toModifiedJulianDay (localDay lt)) + fromRational (timeOfDayToDayFraction (localTimeOfDay lt)) -- | Map a plot coordinate to a LocalTime. localTimeFromDouble :: Double -> LocalTime localTimeFromDouble v = LocalTime (ModifiedJulianDay i) (dayFractionToTimeOfDay (toRational d)) where (i,d) = properFraction v -- | TimeSeq is a (potentially infinite) set of times. When passed -- a reference time, the function returns a a pair of lists. The first -- contains all times in the set less than the reference time in -- decreasing order. The second contains all times in the set greater -- than or equal to the reference time, in increasing order. type TimeSeq = LocalTime-> ([LocalTime],[LocalTime]) coverTS :: TimeSeq -> LocalTime -> LocalTime -> [LocalTime] coverTS tseq min max = min' ++ enumerateTS tseq min max ++ max' where min' = if elemTS min tseq then [] else take 1 (fst (tseq min)) max' = if elemTS max tseq then [] else take 1 (snd (tseq max)) enumerateTS :: TimeSeq -> LocalTime -> LocalTime -> [LocalTime] enumerateTS tseq min max = reverse (takeWhile (>=min) ts1) ++ takeWhile (<=max) ts2 where (ts1,ts2) = tseq min elemTS :: LocalTime -> TimeSeq -> Bool elemTS t tseq = case tseq t of (_,(t0:_)) | t == t0 -> True _ -> False -- | How to display a time type TimeLabelFn = LocalTime -> String data TimeLabelAlignment = UnderTicks | BetweenTicks deriving (Show) -- | Create an 'AxisFn' to for a time axis. The first 'TimeSeq' sets the -- minor ticks, and the ultimate range will be aligned to its elements. -- The second 'TimeSeq' sets the labels and grid. The third 'TimeSeq' -- sets the second line of labels. The 'TimeLabelFn' is -- used to format LocalTimes for labels. The values to be plotted -- against this axis can be created with 'doubleFromLocalTime'. timeAxis :: TimeSeq -> TimeSeq -> TimeLabelFn -> TimeLabelAlignment -> TimeSeq -> TimeLabelFn -> TimeLabelAlignment -> AxisFn LocalTime timeAxis tseq lseq labelf lal cseq contextf clal pts = AxisData { axis_viewport_ = vmap(min', max'), axis_tropweiv_ = invmap(min', max'), axis_ticks_ = [ (t,2) | t <- times] ++ [ (t,5) | t <- ltimes, visible t], axis_labels_ = [ [ (t,l) | (t,l) <- labels labelf ltimes lal, visible t] , [ (t,l) | (t,l) <- labels contextf ctimes clal, visible t] ], axis_grid_ = [ t | t <- ltimes, visible t] } where (min,max) = case pts of [] -> (refLocalTime,refLocalTime) ps -> (minimum ps, maximum ps) refLocalTime = LocalTime (ModifiedJulianDay 0) midnight times = coverTS tseq min max ltimes = coverTS lseq min max ctimes = coverTS cseq min max min' = minimum times max' = maximum times visible t = min' <= t && t <= max' labels f ts lal = [ (align lal m1' m2', f m1) | (m1,m2) <- zip ts (tail ts) , let m1' = if m1max' then max' else m2 ] align BetweenTicks m1 m2 = avg m1 m2 align UnderTicks m1 m2 = m1 avg m1 m2 = localTimeFromDouble $ m1' + (m2' - m1')/2 where m1' = doubleFromLocalTime m1 m2' = doubleFromLocalTime m2 normalizeTimeOfDay :: LocalTime -> LocalTime normalizeTimeOfDay t@(LocalTime day (TimeOfDay h m s)) | s < 0 = normalizeTimeOfDay (LocalTime day (TimeOfDay h (m-1) (s+60))) | m < 0 = normalizeTimeOfDay (LocalTime day (TimeOfDay (h-1) (m+60) s)) | h < 0 = normalizeTimeOfDay (LocalTime (addDays (-1) day) (TimeOfDay (h+24) m s)) | s >= 60 = normalizeTimeOfDay (LocalTime day (TimeOfDay h (m+s`div'`60) (s`mod'`60))) | m >= 60 = normalizeTimeOfDay (LocalTime day (TimeOfDay (h+m`div`60) (m`mod`60) s)) | h >= 24 = LocalTime (addDays (fromIntegral (h`div`24)) day) (TimeOfDay (h`mod`24) m s) | otherwise = t addTod :: Int -> Int -> Pico -> LocalTime -> LocalTime addTod dh dm ds (LocalTime day (TimeOfDay h m s)) = normalizeTimeOfDay t' where t' = LocalTime day (TimeOfDay (h+dh) (m+dm) (s+ds)) truncateTo :: (HasResolution a) => Fixed a -> Fixed a -> Fixed a truncateTo t step = t - t `mod'` step secondSeq :: Pico -> TimeSeq secondSeq step t = (iterate rev t1, tail (iterate fwd t1)) where h0 = todHour (localTimeOfDay t) m0 = todMin (localTimeOfDay t) s0 = todSec (localTimeOfDay t) `truncateTo` (fromIntegral 1 / 1000) t0 = LocalTime (localDay t) (TimeOfDay h0 m0 s0) t1 = if t0 < t then t0 else (rev t0) rev = addTod 0 0 (negate step) fwd = addTod 0 0 (step) millis1, millis10, millis100, seconds, fiveSeconds :: TimeSeq millis1 = secondSeq (fromIntegral 1 / 1000) millis10 = secondSeq (fromIntegral 1 / 100) millis100 = secondSeq (fromIntegral 1 / 10) seconds = secondSeq (fromIntegral 1) fiveSeconds = secondSeq (fromIntegral 5) minuteSeq :: Int -> TimeSeq minuteSeq step t = (iterate rev t1, tail (iterate fwd t1)) where h0 = todHour (localTimeOfDay t) m0 = todMin (localTimeOfDay t) t0 = LocalTime (localDay t) (TimeOfDay h0 m0 0) t1 = if t0 < t then t0 else (rev t0) rev = addTod 0 (negate step) (fromIntegral 0) fwd = addTod 0 step (fromIntegral 0) minutes, fiveMinutes :: TimeSeq minutes = minuteSeq 1 fiveMinutes = minuteSeq 5 -- | A 'TimeSeq' for hours. hours :: TimeSeq hours t = (iterate rev t1, tail (iterate fwd t1)) where h0 = todHour (localTimeOfDay t) t0 = LocalTime (localDay t) (TimeOfDay h0 0 0) t1 = if t0 < t then t0 else (rev t0) rev = addTod (-1) 0 (fromIntegral 0) fwd = addTod 1 0 (fromIntegral 0) -- | A 'TimeSeq' for calendar days. days :: TimeSeq days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1)) where t0 = localDay t t1 = if (toTime t0) < t then t0 else (rev t0) rev = pred fwd = succ toTime d = LocalTime d midnight -- | A 'TimeSeq' for calendar months. months :: TimeSeq months t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1)) where t0 = let (y,m,d) = toGregorian $ localDay t in fromGregorian y m 1 t1 = if toTime t0 < t then t0 else (rev t0) rev = addGregorianMonthsClip (-1) fwd = addGregorianMonthsClip 1 toTime d = LocalTime d midnight -- | A 'TimeSeq' for calendar years. years :: TimeSeq years t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1)) where t0 = let (y,m,d) = toGregorian $ localDay t in y t1 = if toTime t0 < t then t0 else (rev t0) rev = pred fwd = succ toTime y = LocalTime (fromGregorian y 1 1) midnight -- | A 'TimeSeq' for no sequence at all. noTime :: TimeSeq noTime t = ([],[]) -- | Automatically choose a suitable time axis, based upon the time range -- of data. The values to be plotted against this axis can be created -- with 'doubleFromLocalTime'. autoTimeAxis :: AxisFn LocalTime autoTimeAxis pts | null pts = timeAxis days days (ft "%d-%b-%y") UnderTicks noTime (ft "") UnderTicks [] | tdiff==0 && 100*dsec<1= timeAxis millis1 millis1 (ft "%S%Q") UnderTicks noTime (ft "%S%Q") UnderTicks pts | tdiff==0 && 10*dsec<1 = timeAxis millis10 millis10 (ft "%S%Q") UnderTicks noTime (ft "%S%Q") UnderTicks pts | tdiff==0 && dsec<1 = timeAxis millis10 millis100 (ft "%S%Q") UnderTicks seconds (ft "%M:%S") BetweenTicks pts | tdiff==0 && dsec<5 = timeAxis millis100 seconds (ft "%M:%S%Q") UnderTicks seconds (ft "%M:%S") BetweenTicks pts | tdiff==0 && dsec<32 = timeAxis seconds seconds (ft "%Ss") UnderTicks minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts | tdiff==0 && dsec<120 = timeAxis seconds fiveSeconds (ft "%Ss") UnderTicks minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts | tdiff==0 && dmin<7 = timeAxis fiveSeconds minutes (ft "%Mm") UnderTicks hours (ft "%d-%b-%y %H:00") BetweenTicks pts | tdiff==0 && dmin<32 = timeAxis minutes minutes (ft "%Mm") UnderTicks hours (ft "%d-%b-%y %H:00") BetweenTicks pts | tdiff==0 && dmin<90 = timeAxis minutes fiveMinutes (ft "%Mm") UnderTicks hours (ft "%d-%b-%y %H:00") BetweenTicks pts | tdiff < 2 && dhour<4 = timeAxis fiveMinutes hours (ft "%H:%M") UnderTicks days (ft "%d-%b-%y") BetweenTicks pts | tdiff < 2 && dhour<32 = timeAxis hours hours (ft "%H:%M") UnderTicks days (ft "%d-%b-%y") BetweenTicks pts | tdiff < 4 = timeAxis hours days (ft "%d-%b-%y") BetweenTicks noTime (ft "") BetweenTicks pts | tdiff < 12 = timeAxis days days (ft "%d-%b") BetweenTicks years (ft "%Y") BetweenTicks pts | tdiff < 45 = timeAxis days days (ft "%d") BetweenTicks months (ft "%b-%y") BetweenTicks pts | tdiff < 95 = timeAxis days months (ft "%b-%y") BetweenTicks noTime (ft "") BetweenTicks pts | tdiff < 450 = timeAxis months months (ft "%b-%y") BetweenTicks noTime (ft "") BetweenTicks pts | tdiff < 735 = timeAxis months months (ft "%b") BetweenTicks years (ft "%Y") BetweenTicks pts | tdiff < 1800 = timeAxis months years (ft "%Y") BetweenTicks noTime (ft "") BetweenTicks pts | otherwise = timeAxis years years (ft "%Y") BetweenTicks noTime (ft "") BetweenTicks pts where tdiff = diffDays (localDay t1) (localDay t0) dhour = if tdiff==0 then h1-h0 else 24*fromIntegral tdiff +h1-h0 dmin = 60*dhour+(m1-m0) dsec = fromIntegral (60*dmin) + (s1-s0) (TimeOfDay h0 m0 s0) = localTimeOfDay t0 (TimeOfDay h1 m1 s1) = localTimeOfDay t1 t1 = maximum pts t0 = minimum pts ft = formatTime defaultTimeLocale Chart-0.16/Graphics/Rendering/Chart/Axis/Floating.hs0000644000000000000000000002047712006610042020411 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Floating -- Copyright : (c) Tim Docker 2010 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render floating value axes -- including doubles with linear, log, and percentage scaling. -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Axis.Floating( Percent(..), LinearAxisParams(..), LogValue(..), LogAxisParams(..), defaultLinearAxis, defaultLogAxis, scaledAxis, autoScaledAxis, autoScaledLogAxis, autoSteps, la_labelf, la_nLabels, la_nTicks, loga_labelf ) where import Data.List(minimumBy) import Data.Ord (comparing) import Numeric (showFFloat) import Data.Accessor.Template import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Axis.Types instance PlotValue Double where toValue = id fromValue= id autoAxis = autoScaledAxis defaultLinearAxis -- | A wrapper class for doubles used to indicate they are to -- be plotted against a percentage axis. newtype Percent = Percent {unPercent :: Double} deriving (Eq,Ord,Num,Real,Fractional,RealFrac,Floating,RealFloat) instance Show Percent where show (Percent d) = showD (d*100) ++ "%" instance PlotValue Percent where toValue = unPercent fromValue= Percent autoAxis = autoScaledAxis defaultLinearAxis{-la_labelf_=-} -- | A wrapper class for doubles used to indicate they are to -- be plotted against a log axis. newtype LogValue = LogValue Double deriving (Eq, Ord, Num, Real, Fractional, RealFrac, Floating, RealFloat) instance Show LogValue where show (LogValue x) = show x instance PlotValue LogValue where toValue (LogValue x) = log x fromValue d = LogValue (exp d) autoAxis = autoScaledLogAxis defaultLogAxis showD :: (RealFloat d) => d -> String showD x = case reverse $ showFFloat Nothing x "" of '0':'.':r -> reverse r r -> reverse r data LinearAxisParams a = LinearAxisParams { -- | The function used to show the axes labels. la_labelf_ :: a -> String, -- | The target number of labels to be shown. la_nLabels_ :: Int, -- | The target number of ticks to be shown. la_nTicks_ :: Int } defaultLinearAxis :: (Show a, RealFloat a) => LinearAxisParams a defaultLinearAxis = LinearAxisParams { la_labelf_ = showD, la_nLabels_ = 5, la_nTicks_ = 50 } -- | Generate a linear axis with the specified bounds scaledAxis :: RealFloat a => LinearAxisParams a -> (a,a) -> AxisFn a scaledAxis lap (min,max) ps0 = makeAxis' realToFrac realToFrac (la_labelf_ lap) (labelvs,tickvs,gridvs) where ps = filter isValidNumber ps0 range [] = (0,1) range _ | min == max = if min==0 then (-1,1) else let d = abs (min * 0.01) in (min-d,max+d) | otherwise = (min,max) labelvs = map fromRational $ steps (fromIntegral (la_nLabels_ lap)) r tickvs = map fromRational $ steps (fromIntegral (la_nTicks_ lap)) (minimum labelvs,maximum labelvs) gridvs = labelvs r = range ps -- | Generate a linear axis automatically, scaled appropriately for the -- input data. autoScaledAxis :: RealFloat a => LinearAxisParams a -> AxisFn a autoScaledAxis lap ps0 = scaledAxis lap (min,max) ps0 where (min,max) = (minimum ps0,maximum ps0) steps :: RealFloat a => a -> (a,a) -> [Rational] steps nSteps (min,max) = map ((s*) . fromIntegral) [min' .. max'] where s = chooseStep nSteps (min,max) min' = floor $ realToFrac min / s max' = ceiling $ realToFrac max / s n = (max' - min') chooseStep :: RealFloat a => a -> (a,a) -> Rational chooseStep nsteps (x1,x2) = minimumBy (comparing proximity) steps where delta = x2 - x1 mult = 10 ^^ (floor $ log10 $ delta / nsteps) steps = map (mult*) [0.1,0.2,0.25,0.5,1.0,2.0,2.5,5.0,10,20,25,50] proximity x = abs $ delta / realToFrac x - nsteps -- | Given a target number of values, and a list of input points, -- find evenly spaced values from the set {1*X, 2*X, 2.5*X, 5*X} (where -- X is some power of ten) that evenly cover the input points. autoSteps :: Int -> [Double] -> [Double] autoSteps nSteps vs = map fromRational $ steps (fromIntegral nSteps) r where range [] = (0,1) range _ | min == max = (min-0.5,min+0.5) | otherwise = (min,max) (min,max) = (minimum ps,maximum ps) ps = filter isValidNumber vs r = range ps ---------------------------------------------------------------------- defaultLogAxis :: (Show a, RealFloat a) => LogAxisParams a defaultLogAxis = LogAxisParams { loga_labelf_ = showD } -- | Generate a log axis automatically, scaled appropriate for the -- input data. autoScaledLogAxis :: RealFloat a => LogAxisParams a -> AxisFn a autoScaledLogAxis lap ps0 = makeAxis' (realToFrac . log) (realToFrac . exp) (loga_labelf_ lap) (wrap rlabelvs, wrap rtickvs, wrap rgridvs) where ps = filter (\x -> isValidNumber x && 0 < x) ps0 (min,max) = (minimum ps,maximum ps) wrap = map fromRational range [] = (3,30) range _ | min == max = (realToFrac $ min/3, realToFrac $ max*3) | otherwise = (realToFrac $ min, realToFrac $ max) (rlabelvs, rtickvs, rgridvs) = logTicks (range ps) data LogAxisParams a = LogAxisParams { -- | The function used to show the axes labels. loga_labelf_ :: a -> String } {- Rules: Do not 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],[Rational]) logTicks (low,high) = (major,minor,major) 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 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) inRange (a,b) l x = (lower a l <= x) && (x <= upper b l) major | 17.5 < log10 ratio = map (\x -> 10^^(round x)) $ steps (min 5 (log10 ratio)) (log10 low, log10 high) | 12 < log10 ratio = map (\x -> 10^^(round x)) $ steps ((log10 ratio)/5) (log10 low, log10 high) | 6 < log10 ratio = map (\x -> 10^^(round x)) $ steps ((log10 ratio)/2) (log10 low, log10 high) | 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') log10 :: (Floating a) => a -> a log10 = logBase 10 frac x | 0 <= b = (a,b) | otherwise = (a-1,b+1) where (a,b) = properFraction x $( deriveAccessors ''LinearAxisParams ) $( deriveAccessors ''LogAxisParams ) Chart-0.16/Graphics/Rendering/Chart/Axis/Types.hs0000644000000000000000000003272712006610042017753 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Types -- Copyright : (c) Tim Docker 2006 -- License : BSD-style (see chart/COPYRIGHT) -- -- Type definitions for Axes -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Axis.Types( AxisData(..), AxisT(..), AxisStyle(..), PlotValue(..), AxisFn, defaultAxisLineStyle, defaultAxisStyle, defaultGridLineStyle, makeAxis, makeAxis', axisToRenderable, renderAxisGrid, axisOverhang, vmap, invmap, linMap, invLinMap, axisGridAtTicks, axisGridAtBigTicks, axisGridAtLabels, axisGridHide, axisTicksHide, axisLabelsHide, axisLabelsOverride, axis_viewport, axis_tropweiv, axis_ticks, axis_labels, axis_grid, axis_line_style, axis_label_style, axis_grid_style, axis_label_gap, ) where import qualified Graphics.Rendering.Cairo as C import Data.Time import Data.Fixed import Data.Maybe import System.Locale (defaultTimeLocale) import Control.Monad import Data.List(sort,intersperse) import Data.Accessor.Template import Data.Colour (opaque) import Data.Colour.Names (black, lightgrey) import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable -- | A typeclass abstracting the functions we need -- to be able to plot against an axis of type a class Ord a => PlotValue a where toValue :: a -> Double fromValue:: Double -> a autoAxis :: AxisFn a -- | The basic data associated with an axis showing values of type x. data AxisData x = AxisData { -- | The axis_viewport_ function maps values into device coordinates. axis_viewport_ :: Range -> x -> Double, -- | The axis_tropweiv_ function maps device coordinates back to values. axis_tropweiv_ :: Range -> Double -> x, -- | The tick marks on the axis as pairs. -- The first element is the position on the axis -- (in viewport units) and the second element is the -- length of the tick in output coordinates. -- The tick starts on the axis, and positive numbers are drawn -- towards the plot area. axis_ticks_ :: [(x,Double)], -- | The labels on an axis as pairs. The first element of the pair -- is the position on the axis (in viewport units) and the -- second is the label text string. Note that multiple sets of -- labels can be specified, and are shown successively further -- away from the axis line. axis_labels_ :: [[(x, String)]], -- | The positions on the axis (in viewport units) where -- we want to show grid lines. axis_grid_ :: [ x ] } -- | Control values for how an axis gets displayed. data AxisStyle = AxisStyle { axis_line_style_ :: CairoLineStyle, axis_label_style_ :: CairoFontStyle, axis_grid_style_ :: CairoLineStyle, -- | How far the labels are to be drawn from the axis. axis_label_gap_ :: Double } -- | A function to generate the axis data, given the data values -- to be plotted against it. type AxisFn x = [x] -> AxisData x -- | Collect the information we need to render an axis. The -- bool is true if the axis direction is reversed. data AxisT x = AxisT RectEdge AxisStyle Bool (AxisData x) -- | Construct a renderable from an axis, in order that -- it can be composed with other renderables and drawn. This -- does not include the drawing of the grid, which must be done -- separately by the `renderAxisGrid` function. axisToRenderable :: AxisT x -> Renderable x axisToRenderable at = Renderable { minsize = minsizeAxis at, render = renderAxis at } -- | Modifier to remove grid lines from an axis axisGridHide :: AxisData x -> AxisData x axisGridHide ad = ad{ axis_grid_ = [] } -- | Modifier to position grid lines to line up with the ticks axisGridAtTicks :: AxisData x -> AxisData x axisGridAtTicks ad = ad{ axis_grid_ = map fst (axis_ticks_ ad) } -- | Modifier to position grid lines to line up with only the major ticks axisGridAtBigTicks :: AxisData x -> AxisData x axisGridAtBigTicks ad = ad{ axis_grid_ = map fst $ filter ((> minimum (map (abs.snd) (axis_ticks_ ad))).snd) $ axis_ticks_ ad } -- | Modifier to position grid lines to line up with the labels axisGridAtLabels :: AxisData x -> AxisData x axisGridAtLabels ad = ad{ axis_grid_ = map fst vs } where vs = case axis_labels_ ad of [] -> [] ls -> head ls -- | Modifier to remove ticks from an axis axisTicksHide :: AxisData x -> AxisData x axisTicksHide ad = ad{ axis_ticks_ = [] } -- | Modifier to remove labels from an axis axisLabelsHide :: AxisData x -> AxisData x axisLabelsHide ad = ad{ axis_labels_ = []} -- | Modifier to change labels on an axis axisLabelsOverride :: [(x,String)] -> AxisData x -> AxisData x axisLabelsOverride o ad = ad{ axis_labels_ = [o] } minsizeAxis :: AxisT x -> CRender RectSize minsizeAxis (AxisT at as rev ad) = do labelSizes <- preserveCState $ do setFontStyle (axis_label_style_ as) mapM (mapM textSize) (labelTexts ad) let ag = axis_label_gap_ as let tsize = maximum ([0] ++ [ max 0 (-l) | (v,l) <- axis_ticks_ ad ]) let hw = maximum0 (map (maximum0.map fst) labelSizes) let hh = ag + tsize + (sum . intersperse ag . map (maximum0.map snd) $ labelSizes) let vw = ag + tsize + (sum . intersperse ag . map (maximum0.map fst) $ labelSizes) let vh = maximum0 (map (maximum0.map snd) labelSizes) let sz = case at of E_Top -> (hw,hh) E_Bottom -> (hw,hh) E_Left -> (vw,vh) E_Right -> (vw,vh) return sz labelTexts :: AxisData a -> [[String]] labelTexts ad = map (map snd) (axis_labels_ ad) maximum0 [] = 0 maximum0 vs = maximum vs -- | Calculate the amount by which the labels extend beyond -- the ends of the axis. axisOverhang :: Ord x => AxisT x -> CRender (Double,Double) axisOverhang (AxisT at as rev ad) = do let labels = map snd . sort . concat . axis_labels_ $ ad labelSizes <- preserveCState $ do setFontStyle (axis_label_style_ as) mapM textSize labels 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 x -> RectSize -> CRender (PickFn x) renderAxis at@(AxisT et as rev ad) sz = do let ls = axis_line_style_ as preserveCState $ do setLineStyle ls{line_cap_=C.LineCapSquare} strokePath [Point sx sy,Point ex ey] preserveCState $ do setLineStyle ls{line_cap_=C.LineCapButt} mapM_ drawTick (axis_ticks_ ad) preserveCState $ do setFontStyle (axis_label_style_ as) labelSizes <- mapM (mapM textSize) (labelTexts ad) let sizes = map ((+ag).maximum0.map coord) labelSizes let offsets = scanl (+) ag sizes mapM_ drawLabels (zip offsets (axis_labels_ ad)) return pickfn where (sx,sy,ex,ey,tp,axisPoint,invAxisPoint) = axisMapping at sz drawTick (value,length) = let t1 = axisPoint value t2 = t1 `pvadd` (vscale length tp) in strokePath [t1,t2] (hta,vta,coord,awayFromAxis) = case et of E_Top -> (HTA_Centre, VTA_Bottom, snd, \v -> (Vector 0 (-v))) E_Bottom -> (HTA_Centre, VTA_Top, snd, \v -> (Vector 0 v)) E_Left -> (HTA_Right, VTA_Centre, fst, \v -> (Vector (-v) 0)) E_Right -> (HTA_Left, VTA_Centre, fst, \v -> (Vector v 0)) avoidOverlaps labels = do rects <- mapM labelDrawRect labels return $ map snd . head . filter (noOverlaps . map fst) $ map (\n -> eachNth n rects) [0 .. length rects] labelDrawRect (value,s) = do let pt = axisPoint value `pvadd` (awayFromAxis ag) r <- textDrawRect hta vta pt s return (hBufferRect r,(value,s)) drawLabels (offset,labels) = do labels' <- avoidOverlaps labels mapM_ drawLabel labels' where drawLabel (value,s) = do drawText hta vta (axisPoint value `pvadd` (awayFromAxis offset)) s textSize s ag = axis_label_gap_ as pickfn = Just . invAxisPoint hBufferRect :: Rect -> Rect hBufferRect (Rect p (Point x y)) = Rect p $ Point x' y where x' = x + w/2 w = x - (p_x p) noOverlaps :: [Rect] -> Bool noOverlaps [] = True noOverlaps [_] = True noOverlaps (x:y:l) | rectsOverlap x y = False | otherwise = noOverlaps (y:l) rectsOverlap :: Rect -> Rect -> Bool rectsOverlap (Rect p1 p2) r = any (withinRect r) ps where (Point x1 y1) = p1 (Point x2 y2) = p2 p3 = Point x1 y2 p4 = Point x2 y1 ps = [p1,p2,p3,p4] eachNth n = skipN where n' = n - 1 skipN [] = [] skipN (x:xs) = x : skipN (drop n' xs) withinRect :: Rect -> Point -> Bool withinRect (Rect (Point x1 y1) (Point x2 y2)) (Point x y) = and [x >= x1 && x <= x2, y >= y1 && y <= y2] axisMapping :: AxisT z -> RectSize -> (Double,Double,Double,Double,Vector,z->Point,Point->z) axisMapping (AxisT et as rev ad) (x2,y2) = case et of E_Top -> (x1,y2,x2,y2, (Vector 0 1), mapx y2, imapx) E_Bottom -> (x1,y1,x2,y1, (Vector 0 (-1)), mapx y1, imapx) E_Left -> (x2,y2,x2,y1, (Vector (1) 0), mapy x2, imapy) E_Right -> (x1,y2,x1,y1, (Vector (-1) 0), mapy x1, imapy) where (x1,y1) = (0,0) xr = reverse (x1,x2) yr = reverse (y2,y1) mapx y x = Point (axis_viewport_ ad xr x) y mapy x y = Point x (axis_viewport_ ad yr y) imapx (Point x _) = axis_tropweiv_ ad xr x imapy (Point _ y) = axis_tropweiv_ ad yr y reverse r@(r0,r1) = if rev then (r1,r0) else r -- renderAxisGrid :: RectSize -> AxisT z -> CRender () renderAxisGrid sz@(w,h) at@(AxisT re as rev ad) = do preserveCState $ do setLineStyle (axis_grid_style_ as) mapM_ (drawGridLine re) (axis_grid_ ad) where (sx,sy,ex,ey,tp,axisPoint,invAxisPoint) = axisMapping at sz 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 strokePath [Point v' 0,Point v' h] hline v = let v' = p_y (axisPoint v) in strokePath [Point 0 v',Point w v'] -- | Construct an axis given the positions for ticks, grid lines, and -- labels, and the labelling function makeAxis :: PlotValue x => (x -> String) -> ([x],[x],[x]) -> AxisData x makeAxis labelf (labelvs, tickvs, gridvs) = AxisData { axis_viewport_ = newViewport, axis_tropweiv_ = newTropweiv, axis_ticks_ = newTicks, axis_grid_ = gridvs, axis_labels_ = [newLabels] } where newViewport = vmap (min',max') newTropweiv = invmap (min',max') newTicks = [ (v,2) | v <- tickvs ] ++ [ (v,5) | v <- labelvs ] newLabels = [ (v,labelf v) | v <- labelvs ] min' = minimum labelvs max' = maximum labelvs -- | Construct an axis given the positions for ticks, grid lines, and -- labels, and the positioning and labelling functions makeAxis' :: Ord x => (x -> Double) -> (Double -> x) -> (x -> String) -> ([x],[x],[x]) -> AxisData x makeAxis' t f labelf (labelvs, tickvs, gridvs) = AxisData { axis_viewport_ = linMap t (minimum labelvs, maximum labelvs), axis_tropweiv_ = invLinMap f t (minimum labelvs, maximum labelvs), axis_ticks_ = zip tickvs (repeat 2) ++ zip labelvs (repeat 5), axis_grid_ = gridvs, axis_labels_ = [[ (v,labelf v) | v <- labelvs ]] } ---------------------------------------------------------------------- defaultAxisLineStyle :: CairoLineStyle defaultAxisLineStyle = solidLine 1 $ opaque black defaultGridLineStyle :: CairoLineStyle defaultGridLineStyle = dashedLine 1 [5,5] $ opaque lightgrey defaultAxisStyle :: AxisStyle defaultAxisStyle = AxisStyle { axis_line_style_ = defaultAxisLineStyle, axis_label_style_ = defaultFontStyle, axis_grid_style_ = defaultGridLineStyle, axis_label_gap_ = 10 } ---------------------------------------------------------------------- -- | A linear mapping of points in one range to another. vmap :: PlotValue x => (x,x) -> Range -> x -> Double vmap (v1,v2) (v3,v4) v = v3 + (toValue v - toValue v1) * (v4-v3) / (toValue v2 - toValue v1) -- | The inverse mapping from device co-ordinate range back to -- interesting values. invmap :: PlotValue x => (x,x) -> Range -> Double -> x invmap (v3,v4) (d1,d2) d = fromValue (toValue v3 + ( (d-d1) * doubleRange / (d2-d1) )) where doubleRange = toValue v4 - toValue v3 -- | A linear mapping of points in one range to another. linMap :: (a -> Double) -> (a,a) -> Range -> a -> Double linMap f (x1,x2) (d1,d2) x = d1 + (d2 - d1) * (f x - f x1) / (f x2 - f x1) -- | An inverse linear mapping of points from one range to another. invLinMap :: (Double -> a) -> (a -> Double) -> (a,a) -> Range -> Double -> a invLinMap f t (v3,v4) (d1,d2) d = f (t v3 + ( (d-d1) * doubleRange / (d2-d1) )) where doubleRange = t v4 - t v3 ---------------------------------------------------------------------- -- Template haskell to derive an instance of Data.Accessor.Accessor for -- each field. $( deriveAccessors ''AxisData ) $( deriveAccessors ''AxisStyle ) Chart-0.16/Graphics/Rendering/Chart/Axis/Int.hs0000644000000000000000000000506212006610042017371 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Chart.Axis.Int -- Copyright : (c) Tim Docker 2010 -- License : BSD-style (see chart/COPYRIGHT) -- -- Calculate and render integer indexed axes {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -XTemplateHaskell #-} module Graphics.Rendering.Chart.Axis.Int( defaultIntAxis, scaledIntAxis, autoScaledIntAxis ) where import Data.List(genericLength) import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Axis.Types import Graphics.Rendering.Chart.Axis.Floating instance PlotValue Int where toValue = fromIntegral fromValue = round autoAxis = autoScaledIntAxis defaultIntAxis instance PlotValue Integer where toValue = fromIntegral fromValue = round autoAxis = autoScaledIntAxis defaultIntAxis defaultIntAxis :: (Show a) => LinearAxisParams a defaultIntAxis = LinearAxisParams { la_labelf_ = show, la_nLabels_ = 5, la_nTicks_ = 10 } autoScaledIntAxis :: (Integral i, PlotValue i) => LinearAxisParams i -> AxisFn i autoScaledIntAxis lap ps = scaledIntAxis lap (min,max) ps where (min,max) = (minimum ps,maximum ps) scaledIntAxis :: (Integral i, PlotValue i) => LinearAxisParams i -> (i,i) -> AxisFn i scaledIntAxis lap (min,max) ps = makeAxis (la_labelf_ lap) (labelvs,tickvs,gridvs) where range [] = (0,1) range _ | min == max = (fromIntegral $ min-1, fromIntegral $ min+1) | otherwise = (fromIntegral $ min, fromIntegral $ max) -- labelvs :: [i] labelvs = stepsInt (fromIntegral $ la_nLabels_ lap) r tickvs = stepsInt (fromIntegral $ la_nTicks_ lap) ( fromIntegral $ minimum labelvs , fromIntegral $ maximum labelvs ) gridvs = labelvs r = range ps stepsInt :: Integral a => a -> Range -> [a] stepsInt nSteps range = bestSize (goodness alt0) alt0 alts where bestSize n a (a':as) = let n' = goodness a' in if n' < n then bestSize n' a' as else a goodness vs = abs (genericLength vs - nSteps) (alt0:alts) = map (\n -> steps n range) sampleSteps sampleSteps = [1,2,5] ++ sampleSteps1 sampleSteps1 = [10,20,25,50] ++ map (*10) sampleSteps1 steps size (min,max) = takeWhile ( Layout1 Double Double layout lwidth = layout1 where layout1 = layout1_title ^= "Amplitude Modulation" $ layout1_plots ^= [Left (toPlot sinusoid1), Left (toPlot sinusoid2)] $ layout1_plot_background ^= Just (solidFillStyle $ opaque white) $ defaultLayout1 am x = (sin (x*pi/45) + 1) / 2 * (sin (x*pi/5)) sinusoid1 = plot_lines_values ^= [[ (x,(am x)) | x <- [0,(0.5)..400]]] $ plot_lines_style ^= solidLine lwidth (opaque blue) $ plot_lines_title ^="am" $ defaultPlotLines sinusoid2 = plot_points_style ^= filledCircles 2 (opaque red) $ plot_points_values ^= [ (x,(am x)) | x <- [0,7..400]] $ plot_points_title ^="am points" $ defaultPlotPoints main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart 0.25) 320 240 "test1_small.png" main1 ["big"] = renderableToPNGFile (chart 0.25) 800 600 "test1_big.png" main = getArgs >>= main1 Chart-0.16/tests/Prices.hs0000644000000000000000000003150212006610042013602 0ustar0000000000000000module Prices where import Data.Time.Calendar import Data.Time.LocalTime rawPrices = [ (03,05,2005, 16.18, 42.02), (04,05,2005, 16.25, 42.31), (05,05,2005, 16.50, 42.95), (06,05,2005, 16.52, 43.50), (09,05,2005, 16.84, 44.91), (10,05,2005, 16.70, 44.55), (11,05,2005, 16.43, 43.63), (12,05,2005, 16.29, 43.18), (13,05,2005, 15.95, 42.40), (16,05,2005, 15.55, 41.65), (17,05,2005, 15.71, 42.17), (18,05,2005, 15.93, 42.37), (19,05,2005, 16.20, 42.85), (20,05,2005, 15.88, 42.30), (23,05,2005, 15.92, 42.53), (24,05,2005, 16.25, 42.81), (25,05,2005, 16.20, 42.67), (26,05,2005, 16.05, 42.35), (27,05,2005, 16.45, 43.12), (30,05,2005, 16.85, 43.24), (31,05,2005, 16.68, 42.57), (01,06,2005, 16.85, 43.22), (02,06,2005, 17.17, 43.85), (03,06,2005, 17.42, 44.15), (06,06,2005, 17.50, 44.07), (07,06,2005, 17.37, 43.76), (08,06,2005, 17.15, 43.21), (09,06,2005, 17.12, 43.42), (10,06,2005, 17.15, 43.27), (14,06,2005, 17.34, 43.30), (15,06,2005, 17.46, 43.90), (16,06,2005, 17.71, 44.43), (17,06,2005, 18.25, 45.45), (20,06,2005, 18.23, 45.16), (21,06,2005, 18.26, 45.54), (22,06,2005, 18.11, 45.06), (23,06,2005, 17.79, 44.65), (24,06,2005, 17.76, 44.43), (27,06,2005, 17.63, 44.22), (28,06,2005, 18.08, 44.94), (29,06,2005, 18.13, 44.80), (30,06,2005, 18.15, 44.82), (01,07,2005, 18.09, 45.12), (04,07,2005, 18.20, 45.20), (05,07,2005, 18.45, 45.85), (06,07,2005, 18.40, 45.91), (07,07,2005, 18.60, 46.35), (08,07,2005, 18.38, 45.76), (11,07,2005, 18.80, 46.41), (12,07,2005, 18.60, 45.86), (13,07,2005, 18.73, 46.00), (14,07,2005, 18.70, 46.44), (15,07,2005, 18.67, 46.25), (18,07,2005, 18.54, 45.77), (19,07,2005, 18.20, 45.21), (20,07,2005, 18.65, 46.13), (21,07,2005, 19.00, 46.87), (22,07,2005, 19.09, 47.32), (25,07,2005, 19.22, 47.36), (26,07,2005, 19.19, 47.66), (27,07,2005, 19.17, 47.64), (28,07,2005, 19.15, 47.98), (29,07,2005, 19.36, 49.12), (01,08,2005, 19.40, 49.30), (02,08,2005, 19.30, 49.17), (03,08,2005, 19.52, 49.91), (04,08,2005, 19.80, 50.60), (05,08,2005, 19.60, 50.40), (08,08,2005, 19.92, 50.94), (09,08,2005, 20.34, 52.09), (10,08,2005, 20.45, 51.42), (11,08,2005, 20.74, 52.30), (12,08,2005, 21.05, 53.01), (15,08,2005, 21.16, 53.02), (16,08,2005, 20.90, 52.74), (17,08,2005, 20.55, 51.93), (18,08,2005, 20.28, 51.42), (19,08,2005, 20.68, 52.20), (22,08,2005, 21.22, 53.10), (23,08,2005, 21.07, 53.01), (24,08,2005, 20.56, 52.72), (25,08,2005, 19.90, 50.45), (26,08,2005, 20.60, 51.42), (29,08,2005, 20.03, 50.10), (30,08,2005, 20.47, 50.74), (31,08,2005, 20.46, 50.31), (01,09,2005, 20.93, 51.80), (02,09,2005, 20.83, 51.60), (05,09,2005, 20.46, 51.56), (06,09,2005, 20.25, 50.60), (07,09,2005, 20.55, 51.54), (08,09,2005, 20.03, 50.55), (09,09,2005, 20.19, 50.90), (12,09,2005, 20.20, 51.27), (13,09,2005, 20.47, 51.91), (14,09,2005, 20.59, 51.59), (15,09,2005, 20.70, 52.44), (16,09,2005, 20.99, 53.77), (19,09,2005, 21.39, 55.45), (20,09,2005, 21.53, 55.88), (21,09,2005, 20.89, 54.63), (22,09,2005, 21.41, 55.50), (23,09,2005, 21.30, 55.56), (26,09,2005, 21.86, 57.55), (27,09,2005, 22.01, 58.56), (28,09,2005, 21.81, 58.26), (29,09,2005, 22.48, 60.01), (30,09,2005, 22.25, 59.14), (03,10,2005, 22.30, 58.93), (04,10,2005, 22.20, 58.61), (05,10,2005, 21.45, 57.10), (06,10,2005, 20.76, 56.30), (07,10,2005, 20.47, 56.50), (10,10,2005, 20.72, 57.25), (11,10,2005, 20.33, 57.00), (12,10,2005, 20.83, 57.48), (13,10,2005, 20.47, 56.69), (14,10,2005, 19.98, 55.21), (17,10,2005, 20.05, 55.95), (18,10,2005, 20.75, 57.90), (19,10,2005, 20.05, 56.19), (20,10,2005, 20.01, 56.30), (21,10,2005, 20.03, 55.82), (24,10,2005, 19.77, 54.27), (25,10,2005, 20.09, 54.82), (26,10,2005, 20.42, 55.58), (27,10,2005, 20.49, 55.80), (28,10,2005, 20.10, 54.94), (31,10,2005, 20.75, 56.31), (01,11,2005, 20.89, 57.00), (02,11,2005, 20.70, 57.11), (03,11,2005, 21.28, 58.39), (04,11,2005, 21.35, 58.60), (07,11,2005, 21.09, 58.18), (08,11,2005, 21.35, 59.80), (09,11,2005, 21.03, 59.25), (10,11,2005, 21.11, 59.21), (11,11,2005, 21.12, 59.71), (14,11,2005, 21.60, 61.24), (15,11,2005, 21.53, 60.96), (16,11,2005, 21.42, 60.60), (17,11,2005, 21.40, 60.79), (18,11,2005, 21.85, 62.45), (21,11,2005, 21.71, 62.60), (22,11,2005, 21.67, 61.70), (23,11,2005, 21.55, 60.70), (24,11,2005, 21.86, 61.89), (25,11,2005, 22.02, 62.21), (28,11,2005, 22.22, 62.09), (29,11,2005, 21.83, 61.35), (30,11,2005, 21.87, 61.76), (01,12,2005, 21.50, 60.40), (02,12,2005, 21.95, 61.92), (05,12,2005, 22.03, 63.33), (06,12,2005, 21.83, 62.99), (07,12,2005, 21.85, 63.84), (08,12,2005, 21.56, 63.10), (09,12,2005, 21.80, 63.55), (12,12,2005, 21.92, 63.60), (13,12,2005, 21.65, 63.35), (14,12,2005, 21.72, 63.15), (15,12,2005, 21.69, 63.16), (16,12,2005, 21.60, 62.63), (19,12,2005, 21.87, 63.81), (20,12,2005, 22.10, 65.50), (21,12,2005, 22.50, 67.18), (22,12,2005, 22.49, 67.75), (23,12,2005, 22.58, 68.50), (28,12,2005, 22.59, 68.25), (29,12,2005, 22.93, 69.10), (30,12,2005, 22.75, 69.00), (03,01,2006, 23.18, 69.90), (04,01,2006, 23.85, 71.06), (05,01,2006, 23.60, 69.80), (06,01,2006, 23.35, 68.80), (09,01,2006, 24.06, 70.18), (10,01,2006, 23.85, 69.15), (11,01,2006, 23.88, 69.35), (12,01,2006, 23.80, 70.19), (13,01,2006, 23.73, 70.50), (16,01,2006, 23.74, 71.05), (17,01,2006, 23.96, 71.94), (18,01,2006, 23.73, 70.25), (19,01,2006, 24.45, 72.50), (20,01,2006, 24.66, 74.00), (23,01,2006, 24.47, 73.25), (24,01,2006, 24.84, 74.25), (25,01,2006, 25.08, 73.96), (27,01,2006, 26.05, 76.10), (30,01,2006, 26.58, 78.45), (31,01,2006, 25.80, 75.82), (01,02,2006, 25.99, 75.21), (02,02,2006, 25.50, 74.98), (03,02,2006, 25.53, 74.75), (06,02,2006, 25.85, 75.57), (07,02,2006, 25.70, 75.06), (08,02,2006, 24.37, 72.75), (09,02,2006, 24.68, 72.77), (13,02,2006, 23.88, 70.95), (14,02,2006, 24.16, 72.37), (15,02,2006, 24.35, 71.84), (16,02,2006, 24.29, 71.89), (17,02,2006, 23.88, 71.65), (20,02,2006, 24.54, 74.90), (21,02,2006, 24.98, 75.50), (22,02,2006, 24.90, 73.24), (23,02,2006, 25.28, 74.69), (24,02,2006, 24.55, 72.20), (27,02,2006, 24.66, 73.00), (28,02,2006, 24.25, 71.20), (01,03,2006, 24.03, 70.25), (02,03,2006, 24.45, 70.50), (03,03,2006, 24.34, 70.35), (06,03,2006, 24.51, 70.85), (08,03,2006, 23.60, 67.95), (09,03,2006, 23.70, 68.65), (10,03,2006, 23.37, 67.50), (13,03,2006, 23.93, 70.36), (14,03,2006, 23.64, 69.45), (15,03,2006, 23.90, 69.40), (16,03,2006, 24.46, 70.90), (17,03,2006, 24.70, 71.25), (20,03,2006, 25.24, 72.85), (21,03,2006, 25.32, 73.08), (22,03,2006, 25.18, 72.99), (23,03,2006, 25.57, 74.34), (24,03,2006, 25.92, 75.23), (27,03,2006, 26.78, 77.05), (28,03,2006, 26.85, 77.13), (30,03,2006, 27.60, 77.96), (31,03,2006, 28.00, 78.85), (03,01,2007, 23.18, 69.90), (04,01,2007, 23.85, 71.06), (05,01,2007, 23.60, 69.80), (06,01,2007, 23.35, 68.80), (09,01,2007, 24.06, 70.18), (10,01,2007, 23.85, 69.15), (11,01,2007, 23.88, 69.35), (12,01,2007, 23.80, 70.19), (13,01,2007, 23.73, 70.50), (16,01,2007, 23.74, 71.05), (17,01,2007, 23.96, 71.94), (18,01,2007, 23.73, 70.25), (19,01,2007, 24.45, 72.50), (20,01,2007, 24.66, 74.00), (23,01,2007, 24.47, 73.25), (24,01,2007, 24.84, 74.25), (25,01,2007, 25.08, 73.96), (27,01,2007, 26.05, 76.10), (30,01,2007, 26.58, 78.45), (31,01,2007, 25.80, 75.82), (01,02,2007, 25.99, 75.21), (02,02,2007, 25.50, 74.98), (03,02,2007, 25.53, 74.75), (06,02,2007, 25.85, 75.57), (07,02,2007, 25.70, 75.06), (08,02,2007, 24.37, 72.75), (09,02,2007, 24.68, 72.77), (13,02,2007, 23.88, 70.95), (14,02,2007, 24.16, 72.37), (15,02,2007, 24.35, 71.84), (16,02,2007, 24.29, 71.89), (17,02,2007, 23.88, 71.65), (20,02,2007, 24.54, 74.90), (21,02,2007, 24.98, 75.50), (22,02,2007, 24.90, 73.24), (23,02,2007, 25.28, 74.69), (24,02,2007, 24.55, 72.20), (27,02,2007, 24.66, 73.00), (28,02,2007, 24.25, 71.20), (01,03,2007, 24.03, 70.25), (02,03,2007, 24.45, 70.50), (03,03,2007, 24.34, 70.35), (06,03,2007, 24.51, 70.85), (08,03,2007, 23.60, 67.95), (09,03,2007, 23.70, 68.65), (10,03,2007, 23.37, 67.50), (13,03,2007, 23.93, 70.36), (14,03,2007, 23.64, 69.45), (15,03,2007, 23.90, 69.40), (16,03,2007, 24.46, 70.90), (17,03,2007, 24.70, 71.25), (20,03,2007, 25.24, 72.85), (21,03,2007, 25.32, 73.08), (22,03,2007, 25.18, 72.99), (23,03,2007, 25.57, 74.34), (24,03,2007, 25.92, 75.23), (27,03,2007, 26.78, 77.05), (28,03,2007, 26.85, 77.13), (30,03,2007, 27.60, 77.96), (31,03,2007, 28.00, 78.85) ] rawHourly = [ (03,05,2005,00, 16.18, 42.02), (03,05,2005,01, 16.25, 42.31), (03,05,2005,02, 16.50, 42.95), (03,05,2005,03, 16.52, 43.50), (03,05,2005,04, 16.84, 44.91), (03,05,2005,05, 16.70, 44.55), (03,05,2005,06, 16.43, 43.63), (03,05,2005,07, 16.29, 43.18), (03,05,2005,08, 15.95, 42.40), (03,05,2005,09, 15.55, 41.65), (03,05,2005,10, 15.71, 42.17), (03,05,2005,11, 15.93, 42.37), (03,05,2005,12, 16.20, 42.85), (03,05,2005,13, 15.88, 42.30), (03,05,2005,14, 15.92, 42.53), (03,05,2005,15, 16.25, 42.81), (03,05,2005,16, 16.20, 42.67), (03,05,2005,17, 16.05, 42.35), (03,05,2005,18, 16.45, 43.12), (03,05,2005,19, 16.85, 43.24), (03,05,2005,20, 16.68, 42.57), (03,05,2005,21, 16.85, 43.22), (03,05,2005,22, 17.17, 43.85), (03,05,2005,23, 17.42, 44.15), (04,05,2005,00, 17.50, 44.07), (04,05,2005,01, 17.37, 43.76), (04,05,2005,02, 17.15, 43.21), (04,05,2005,03, 17.12, 43.42), (04,05,2005,04, 17.15, 43.27), (04,05,2005,05, 17.34, 43.30), (04,05,2005,06, 17.46, 43.90), (04,05,2005,07, 17.71, 44.43), (04,05,2005,08, 18.25, 45.45), (04,05,2005,09, 18.23, 45.16), (04,05,2005,10, 18.26, 45.54), (04,05,2005,11, 18.11, 45.06), (04,05,2005,12, 17.79, 44.65) ] prices :: [(LocalTime,Double,Double)] prices = [ (mkDate dd mm yyyy, p1, p2) | (dd,mm,yyyy,p1,p2) <- rawPrices ] hourlyPrices :: [(LocalTime,Double,Double)] hourlyPrices = [ (mkDateTime dd mm yyyy hh 00, p1, p2) | (dd,mm,yyyy,hh,p1,p2) <- rawHourly ] minutePrices :: [(LocalTime,Double,Double)] minutePrices = [ (mkDateTime dd mm yyyy 05 hh, p1, p2) | (dd,mm,yyyy,hh,p1,p2) <- take 24 rawHourly ] ++ [ (mkDateTime dd mm yyyy 05 (hh+24), p1, p2) | (dd,mm,yyyy,hh,p1,p2) <- take 24 rawHourly ] secondPrices :: [(LocalTime,Double,Double)] secondPrices = [ (mkSeconds ss, p1, p2) | (ss,(_,_,_,p1,p2)) <- zip [0..] rawPrices ] filterPrices prices t1 t2 = [ v | v@(d,_,_) <- prices , let t = d in t >= t1 && t <= t2] prices1 = filterPrices prices (mkDate 1 1 2005) (mkDate 31 12 2005) prices2 = filterPrices prices (mkDate 1 6 2005) (mkDate 1 9 2005) prices3 = filterPrices prices (mkDate 1 1 2006) (mkDate 10 1 2006) prices4 = filterPrices prices (mkDate 1 8 2005) (mkDate 31 8 2005) prices5 = filterPrices prices (mkDate 1 6 2005) (mkDate 15 7 2005) prices6 = filterPrices prices (mkDate 1 6 2005) (mkDate 2 7 2005) prices7 = filterPrices prices (mkDate 20 6 2005) (mkDate 12 7 2005) prices8 = filterPrices prices (mkDate 6 6 2005) (mkDate 9 6 2005) prices9 = filterPrices prices (mkDate 6 6 2005) (mkDate 8 6 2005) prices10 = hourlyPrices prices10a = take 31 hourlyPrices prices10b = take 15 hourlyPrices prices11 = filterPrices hourlyPrices (mkDateTime 3 5 2005 02 30) (mkDateTime 4 5 2005 02 30) prices12 = filterPrices hourlyPrices (mkDateTime 3 5 2005 02 30) (mkDateTime 3 5 2005 06 30) prices13 = minutePrices prices13a = take 24 minutePrices prices13b = take 16 minutePrices prices14 = secondPrices prices14a = take 90 secondPrices prices14b = take 35 secondPrices prices14c = take 30 secondPrices prices14d = take 7 secondPrices mkDate dd mm yyyy = LocalTime (fromGregorian (fromIntegral yyyy) mm dd) midnight mkDateTime dd mm yyyy hh nn = LocalTime (fromGregorian (fromIntegral yyyy) mm dd) (dayFractionToTimeOfDay ((hh*60+nn)/1440)) mkSeconds ss = LocalTime (fromGregorian (fromIntegral 2009) 11 23) (dayFractionToTimeOfDay (((14*60+32)*60+ss)/(1440*60))) Chart-0.16/tests/Test8.hs0000644000000000000000000000131112006610042013357 0ustar0000000000000000module Test8 where import Graphics.Rendering.Chart import Data.Accessor import System.Environment(getArgs) chart :: Renderable () chart = toRenderable layout where values = [ ("eggs",38,e), ("milk",45,e), ("bread",11,e1), ("salmon",8,e) ] e = 0 e1 = 25 layout = pie_title ^= "Pie Chart Example" $ pie_plot ^: pie_data ^= [ defaultPieItem{pitem_value_=v,pitem_label_=s,pitem_offset_=o} | (s,v,o) <- values ] $ defaultPieLayout main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile chart 320 240 "test8_small.png" main1 ["big"] = renderableToPNGFile chart 800 600 "test8_big.png" main = getArgs >>= main1 Chart-0.16/tests/TestParametric.hs0000644000000000000000000000153112006610042015303 0ustar0000000000000000module TestParametric where import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names import Data.Accessor import System.Environment(getArgs) chart lwidth = toRenderable layout where circle = [ (r a * sin (a*dr),r a * cos (a*dr)) | a <- [0,0.5..360::Double] ] where dr = 2 * pi / 360 r a = 0.8 * cos (a * 20 * pi /360) circleP = plot_lines_values ^= [circle] $ plot_lines_style ^= solidLine lwidth (opaque blue) $ defaultPlotLines layout = layout1_title ^= "Parametric Plot" $ layout1_plots ^= [Left (toPlot circleP)] $ defaultLayout1 main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart 0.25) 320 240 "test1_small.png" main1 ["big"] = renderableToPNGFile (chart 0.25) 800 600 "test1_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test3.hs0000644000000000000000000000225112006610042013356 0ustar0000000000000000module Test3 where import Graphics.Rendering.Chart import Data.Time.LocalTime import Data.Colour import Data.Colour.Names import Data.Colour.SRGB import Data.Accessor import System.Environment(getArgs) import Prices(prices1) green1 = opaque $ sRGB 0.5 1 0.5 blue1 = opaque $ sRGB 0.5 0.5 1 chart = toRenderable layout where price1 = plot_fillbetween_style ^= solidFillStyle green1 $ plot_fillbetween_values ^= [ (d,(0,v2)) | (d,v1,v2) <- prices1] $ plot_fillbetween_title ^= "price 1" $ defaultPlotFillBetween price2 = plot_fillbetween_style ^= solidFillStyle blue1 $ plot_fillbetween_values ^= [ (d,(0,v1)) | (d,v1,v2) <- prices1] $ plot_fillbetween_title ^= "price 2" $ defaultPlotFillBetween layout = layout1_title ^= "Price History" $ layout1_grid_last ^= True $ layout1_plots ^= [Left (toPlot price1), Left (toPlot price2)] $ defaultLayout1 main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile chart 320 240 "test3_small.png" main1 ["big"] = renderableToPNGFile chart 800 600 "test3_big.png" main = getArgs >>= main1 Chart-0.16/tests/all_tests.hs0000644000000000000000000003774112006610042014362 0ustar0000000000000000import qualified Graphics.Rendering.Cairo as C import Graphics.Rendering.Chart import Graphics.Rendering.Chart.Simple import Graphics.Rendering.Chart.Grid import System.Environment(getArgs) import System.Time import System.Random import Data.Time.LocalTime import Data.Accessor import Data.Accessor.Tuple import Data.Colour import Data.Colour.Names import Data.Colour.SRGB import Data.List(sort,nub,scanl1) import qualified Data.Map as Map import Control.Monad import Prices import qualified Test1 import qualified Test2 import qualified Test3 import qualified Test4 import qualified Test5 import qualified Test6 import qualified Test7 import qualified Test8 import qualified Test9 import qualified Test14 import qualified Test14a import qualified Test15 import qualified Test17 import qualified TestParametric import qualified TestSparkLines data OutputType = PNG | PS | PDF | SVG chooseLineWidth PNG = 1.0 chooseLineWidth PDF = 0.25 chooseLineWidth PS = 0.25 chooseLineWidth SVG = 0.25 fwhite = solidFillStyle $ opaque white test1a :: Double -> Renderable () test1a lwidth = fillBackground fwhite $ (gridToRenderable t) where t = weights (1,1) $ aboveN [ besideN [rf g1, rf g2, rf g3], besideN [rf g4, rf g5, rf g6] ] g1 = layout1_title ^= "minimal" $ layout1_bottom_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) $ Test1.layout lwidth g2 = layout1_title ^= "with borders" $ layout1_bottom_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) $ layout1_top_axis ^: axisBorderOnly $ layout1_right_axis ^: axisBorderOnly $ Test1.layout lwidth g3 = layout1_title ^= "default" $ Test1.layout lwidth g4 = layout1_title ^= "tight grid" $ layout1_left_axis ^: laxis_generate ^= axis $ layout1_left_axis ^: laxis_override ^= axisGridAtTicks $ layout1_bottom_axis ^: laxis_generate ^= axis $ layout1_bottom_axis ^: laxis_override ^= axisGridAtTicks $ Test1.layout lwidth where axis = autoScaledAxis ( la_nLabels ^= 5 $ la_nTicks ^= 20 $ defaultLinearAxis ) g5 = layout1_title ^= "y linked" $ layout1_yaxes_control ^= linkAxes $ Test1.layout lwidth g6 = layout1_title ^= "everything" $ layout1_yaxes_control ^= linkAxes $ layout1_top_axis ^: laxis_visible ^= const True $ Test1.layout lwidth rf = tval.toRenderable axisBorderOnly = (laxis_visible ^= const True) . (laxis_override ^= (axisGridHide.axisTicksHide.axisLabelsHide)) ---------------------------------------------------------------------- test4d :: OutputType -> Renderable () test4d otype = toRenderable layout where points = plot_points_style ^= filledCircles 3 (opaque red) $ plot_points_values ^= [ (x, 10**x) | x <- [0.5,1,1.5,2,2.5::Double] ] $ plot_points_title ^= "values" $ defaultPlotPoints lines = plot_lines_values ^= [ [(x, 10**x) | x <- [0,3]] ] $ plot_lines_title ^= "values" $ defaultPlotLines layout = layout1_title ^= "Log/Linear Example" $ layout1_bottom_axis ^: laxis_title ^= "horizontal" $ layout1_bottom_axis ^: laxis_reverse ^= False $ layout1_left_axis ^: laxis_generate ^= autoScaledLogAxis defaultLogAxis $ layout1_left_axis ^: laxis_title ^= "vertical" $ layout1_left_axis ^: laxis_reverse ^= False $ layout1_plots ^= [Left (toPlot points `joinPlot` toPlot lines) ] $ defaultLayout1 ---------------------------------------------------------------------- test9 :: PlotBarsAlignment -> OutputType -> Renderable () test9 alignment otype = fillBackground fwhite $ (gridToRenderable t) where t = weights (1,1) $ aboveN [ besideN [rf g0, rf g1, rf g2], besideN [rf g3, rf g4, rf g5] ] g0 = layout "clustered 1" $ plot_bars_style ^= BarsClustered $ plot_bars_spacing ^= BarsFixWidth 25 $ bars1 g1 = layout "clustered/fix width " $ plot_bars_style ^= BarsClustered $ plot_bars_spacing ^= BarsFixWidth 25 $ bars2 g2 = layout "clustered/fix gap " $ plot_bars_style ^= BarsClustered $ plot_bars_spacing ^= BarsFixGap 10 5 $ bars2 g3 = layout "stacked 1" $ plot_bars_style ^= BarsStacked $ plot_bars_spacing ^= BarsFixWidth 25 $ bars1 g4 = layout "stacked/fix width" $ plot_bars_style ^= BarsStacked $ plot_bars_spacing ^= BarsFixWidth 25 $ bars2 g5 = layout "stacked/fix gap" $ plot_bars_style ^= BarsStacked $ plot_bars_spacing ^= BarsFixGap 10 5 $ bars2 rf = tval.toRenderable alabels = [ "Jun", "Jul", "Aug", "Sep", "Oct" ] layout title bars = layout1_title ^= (show alignment ++ "/" ++ title) $ layout1_title_style ^: font_size ^= 10 $ layout1_bottom_axis ^: laxis_generate ^= autoIndexAxis alabels $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) $ layout1_plots ^= [ Left (plotBars bars) ] $ defaultLayout1 :: Layout1 PlotIndex Double bars1 = plot_bars_titles ^= ["Cash"] $ plot_bars_values ^= addIndexes [[20],[45],[30],[70]] $ plot_bars_alignment ^= alignment $ defaultPlotBars bars2 = plot_bars_titles ^= ["Cash","Equity"] $ plot_bars_values ^= addIndexes [[20,45],[45,30],[30,20],[70,25]] $ plot_bars_alignment ^= alignment $ defaultPlotBars ------------------------------------------------------------------------------- test10 :: [(LocalTime,Double,Double)] -> OutputType -> Renderable () test10 prices otype = toRenderable layout where lineStyle c = line_width ^= 3 * chooseLineWidth otype $ line_color ^= c $ defaultPlotLines ^. plot_lines_style price1 = plot_lines_style ^= lineStyle (opaque blue) $ plot_lines_values ^= [[ (d,v) | (d,v,_) <- prices]] $ plot_lines_title ^= "price 1" $ defaultPlotLines price1_area = plot_fillbetween_values ^= [(d, (v * 0.95, v * 1.05)) | (d,v,_) <- prices] $ plot_fillbetween_style ^= solidFillStyle (withOpacity blue 0.2) $ defaultPlotFillBetween price2 = plot_lines_style ^= lineStyle (opaque red) $ plot_lines_values ^= [[ (d, v) | (d,_,v) <- prices]] $ plot_lines_title ^= "price 2" $ defaultPlotLines price2_area = plot_fillbetween_values ^= [(d, (v * 0.95, v * 1.05)) | (d,_,v) <- prices] $ plot_fillbetween_style ^= solidFillStyle (withOpacity red 0.2) $ defaultPlotFillBetween fg = opaque black fg1 = opaque $ sRGB 0.0 0.0 0.15 layout = layout1_title ^="Price History" $ layout1_background ^= solidFillStyle (opaque white) $ layout1_right_axis ^: laxis_override ^= axisGridHide $ layout1_plots ^= [ Left (toPlot price1_area), Right (toPlot price2_area) , Left (toPlot price1), Right (toPlot price2) ] $ setLayout1Foreground fg $ defaultLayout1 ------------------------------------------------------------------------------- -- A quick test of stacked layouts test11 :: OutputType -> Renderable () test11 otype = renderLayout1sStacked [withAnyOrdinate layout1, withAnyOrdinate layout2] where vs1 :: [(Int,Int)] vs1 = [ (2,2), (3,40), (8,400), (12,60) ] vs2 :: [(Int,Double)] vs2 = [ (0,0.7), (3,0.35), (4,0.25), (7, 0.6), (10,0.4) ] allx = map fst vs1 ++ map fst vs2 extendRange = PlotHidden allx [] plot1 = plot_points_style ^= filledCircles 5 (opaque red) $ plot_points_values ^= vs1 $ defaultPlotPoints layout1 = layout1_title ^= "Integer Axis" $ layout1_plots ^= [Left (toPlot plot1), Left (toPlot extendRange)] $ defaultLayout1 plot2 = plot_lines_values ^= [vs2] $ defaultPlotLines layout2 = layout1_title ^= "Float Axis" $ layout1_plots ^= [Left (toPlot plot2), Left (toPlot extendRange)] $ defaultLayout1 ------------------------------------------------------------------------------- -- More of an example that a test: -- configuring axes explicitly configured axes test12 :: OutputType -> Renderable () test12 otype = toRenderable layout where vs1 :: [(Int,Int)] vs1 = [ (2,10), (3,40), (8,400), (12,60) ] baxis = AxisData { axis_viewport_ = vmap (0,15), axis_tropweiv_ = invmap (0,15), axis_ticks_ = [(v,3) | v <- [0,1..15]], axis_grid_ = [0,5..15], axis_labels_ = [[(v,show v) | v <- [0,5..15]]] } laxis = AxisData { axis_viewport_ = vmap (0,500), axis_tropweiv_ = invmap (0,500), axis_ticks_ = [(v,3) | v <- [0,25..500]], axis_grid_ = [0,100..500], axis_labels_ = [[(v,show v) | v <- [0,100..500]]] } plot = plot_lines_values ^= [vs1] $ defaultPlotLines layout = layout1_plots ^= [Left (toPlot plot)] $ layout1_bottom_axis ^: laxis_generate ^= const baxis $ layout1_left_axis ^: laxis_generate ^= const laxis $ layout1_title ^= "Explicit Axes" $ defaultLayout1 ------------------------------------------------------------------------------- -- Plot annotations test test13 otype = fillBackground fwhite $ (gridToRenderable t) where t = weights (1,1) $ aboveN [ besideN [tval (annotated h v) | h <- hs] | v <- vs ] hs = [HTA_Left, HTA_Centre, HTA_Right] vs = [VTA_Top, VTA_Centre, VTA_Bottom] points=[-2..2] pointPlot :: PlotPoints Int Int pointPlot = plot_points_style^= filledCircles 2 (opaque red) $ plot_points_values ^= [(x,x)|x<-points] $ defaultPlotPoints p = Left (toPlot pointPlot) annotated h v = toRenderable ( layout1_plots ^= [Left (toPlot labelPlot), Left (toPlot rotPlot), p] $ defaultLayout1 ) where labelPlot = plot_annotation_hanchor ^= h $ plot_annotation_vanchor ^= v $ plot_annotation_values ^= [(x,x,"Hello World\n(plain)")|x<-points] $ defaultPlotAnnotation rotPlot = plot_annotation_angle ^= -45.0 $ plot_annotation_style ^= defaultFontStyle{font_size_=10,font_weight_=C.FontWeightBold, font_color_ =(opaque blue) } $ plot_annotation_values ^= [(x,x,"Hello World\n(fancy)")|x<-points] $ labelPlot ---------------------------------------------------------------------- -- a quick test to display labels with all combinations -- of anchors misc1 rot otype = fillBackground fwhite $ (gridToRenderable t) where t = weights (1,1) $ aboveN [ besideN [tval (lb h v) | h <- hs] | v <- vs ] lb h v = addMargins (20,20,20,20) $ fillBackground fblue $ crossHairs $ rlabel fs h v rot s s = "Labelling" hs = [HTA_Left, HTA_Centre, HTA_Right] vs = [VTA_Top, VTA_Centre, VTA_Bottom] fwhite = solidFillStyle $ opaque white fblue = solidFillStyle $ opaque $ sRGB 0.8 0.8 1 fs = defaultFontStyle{font_size_=20,font_weight_=C.FontWeightBold} crossHairs r =Renderable { minsize = minsize r, render = \sz@(w,h) -> do let xa = w / 2 let ya = h / 2 strokePath [Point 0 ya,Point w ya] strokePath [Point xa 0,Point xa h] render r sz } ---------------------------------------------------------------------- stdSize = (640,480) allTests :: [ (String, (Int,Int), OutputType -> Renderable ()) ] allTests = [ ("test1", stdSize, \o -> Test1.chart (chooseLineWidth o) ) , ("test1a", stdSize, \o -> test1a (chooseLineWidth o) ) , ("test2a", stdSize, \o -> Test2.chart prices False (chooseLineWidth o)) , ("test2b", stdSize, \o -> Test2.chart prices1 False (chooseLineWidth o)) , ("test2c", stdSize, \o -> Test2.chart prices2 False (chooseLineWidth o)) , ("test2d", stdSize, \o -> Test2.chart prices5 True (chooseLineWidth o)) , ("test2e", stdSize, \o -> Test2.chart prices6 True (chooseLineWidth o)) , ("test2f", stdSize, \o -> Test2.chart prices7 True (chooseLineWidth o)) , ("test2g", stdSize, \o -> Test2.chart prices3 False (chooseLineWidth o)) , ("test2h", stdSize, \o -> Test2.chart prices8 True (chooseLineWidth o)) , ("test2i", stdSize, \o -> Test2.chart prices9 True (chooseLineWidth o)) , ("test2j", stdSize, \o -> Test2.chart prices10 True (chooseLineWidth o)) , ("test2k", stdSize, \o -> Test2.chart prices10a True (chooseLineWidth o)) , ("test2m", stdSize, \o -> Test2.chart prices11 True (chooseLineWidth o)) , ("test2n", stdSize, \o -> Test2.chart prices10b True (chooseLineWidth o)) , ("test2o", stdSize, \o -> Test2.chart prices12 True (chooseLineWidth o)) , ("test2p", stdSize, \o -> Test2.chart prices13 True (chooseLineWidth o)) , ("test2q", stdSize, \o -> Test2.chart prices13a True (chooseLineWidth o)) , ("test2r", stdSize, \o -> Test2.chart prices13b True (chooseLineWidth o)) , ("test2s", stdSize, \o -> Test2.chart prices14 True (chooseLineWidth o)) , ("test2t", stdSize, \o -> Test2.chart prices14a True (chooseLineWidth o)) , ("test2u", stdSize, \o -> Test2.chart prices14b True (chooseLineWidth o)) , ("test2v", stdSize, \o -> Test2.chart prices14c True (chooseLineWidth o)) , ("test2w", stdSize, \o -> Test2.chart prices14d True (chooseLineWidth o)) , ("test3", stdSize, const Test3.chart) , ("test4a", stdSize, const (Test4.chart False False)) , ("test4b", stdSize, const (Test4.chart True False)) , ("test4c", stdSize, const (Test4.chart False True)) , ("test4d", stdSize, test4d) , ("test5", stdSize, \o -> Test5.chart (chooseLineWidth o)) , ("test6", stdSize, const Test6.chart) , ("test7", stdSize, const Test7.chart) , ("test8", stdSize, const Test8.chart) , ("test9", stdSize, const (Test9.chart True)) , ("test9b", stdSize, const (Test9.chart False)) , ("test9c", stdSize, test9 BarsCentered) , ("test9l", stdSize, test9 BarsLeft) , ("test9r", stdSize, test9 BarsRight) , ("test10", stdSize, test10 prices1) , ("test11", stdSize, test11) , ("test12", stdSize, test12) , ("test13", stdSize, test13) , ("test14", stdSize, \o -> Test14.chart (chooseLineWidth o) ) , ("test14a", stdSize, \o -> Test14a.chart (chooseLineWidth o) ) , ("test15a", stdSize, const (Test15.chart (LORows 2))) , ("test15b", stdSize, const (Test15.chart (LOCols 2))) , ("test17", stdSize, \o -> Test17.chart (chooseLineWidth o)) , ("misc1", stdSize, setPickFn nullPickFn . misc1 0) , ("misc1a", stdSize, setPickFn nullPickFn . misc1 45) , ("parametric", stdSize, \o -> TestParametric.chart (chooseLineWidth o) ) , ("sparklines", TestSparkLines.chartSize, const TestSparkLines.chart ) ] main = do args <- getArgs main1 args main1 :: [String] -> IO () main1 ("--pdf":tests) = showTests tests renderToPDF main1 ("--svg":tests) = showTests tests renderToSVG main1 ("--ps":tests) = showTests tests renderToPS main1 ("--png":tests) = showTests tests renderToPNG main1 tests = showTests tests renderToPNG showTests :: [String] -> ((String,(Int,Int),OutputType -> Renderable ()) -> IO()) -> IO () showTests tests ofn = mapM_ doTest (filter (match tests) allTests) where doTest (s,size,f) = do putStrLn (s ++ "... ") ofn (s,size,f) match :: [String] -> (String,s,a) -> Bool match [] t = True match ts (s,_,_) = s `elem` ts renderToPNG (n,(w,h),ir) = renderableToPNGFile (ir PNG) w h (n ++ ".png") >> return () renderToPS (n,(w,h),ir) = renderableToPSFile (ir PS) w h (n ++ ".ps") renderToPDF (n,(w,h),ir) = renderableToPDFFile (ir PDF) w h (n ++ ".pdf") renderToSVG (n,(w,h),ir) = renderableToSVGFile (ir SVG) w h (n ++ ".svg") Chart-0.16/tests/Test15.hs0000644000000000000000000000254712006610042013451 0ustar0000000000000000module Test15 where import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names import Data.Accessor import System.Environment(getArgs) chart lo = toRenderable layout where layout = layout1_title ^= "Legend Test" $ layout1_title_style ^: font_size ^= 10 $ layout1_bottom_axis ^: laxis_generate ^= autoIndexAxis alabels $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) $ layout1_plots ^= [ Left (plotBars bars2) ] $ layout1_legend ^= Just lstyle $ defaultLayout1 :: Layout1 PlotIndex Double bars2 = plot_bars_titles ^= ["A","B","C","D","E","F","G","H","I","J"] $ plot_bars_values ^= addIndexes [[2,3,4,2,1,5,6,4,8,1,3], [7,4,5,6,2,4,4,5,7,8,9] ] $ plot_bars_style ^= BarsClustered $ plot_bars_spacing ^= BarsFixGap 30 5 $ plot_bars_item_styles ^= map mkstyle (cycle defaultColorSeq) $ defaultPlotBars alabels = [ "X", "Y" ] lstyle = legend_orientation ^= lo $ defaultLegendStyle btitle = "" mkstyle c = (solidFillStyle c, Nothing) main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart (LORows 3)) 320 240 "test15_small.png" main1 ["big"] = renderableToPNGFile (chart (LORows 3)) 800 600 "test15_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test6.hs0000644000000000000000000000126612006610042013366 0ustar0000000000000000module Test6 where import Graphics.Rendering.Chart import Graphics.Rendering.Chart.Simple import System.Environment(getArgs) chart :: Renderable () chart = toRenderable (plotLayout 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] main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile chart 320 240 "test6_small.png" main1 ["big"] = renderableToPNGFile chart 800 600 "test6_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test14a.hs0000644000000000000000000000306412006610042013604 0ustar0000000000000000module Test14a where import Graphics.Rendering.Chart import Graphics.Rendering.Chart.Plot import Data.Colour import Data.Colour.Names import Data.Accessor import System.Random import System.Environment(getArgs) import Prices(prices1) -- demonstrate AreaSpots4D chart :: Double -> Renderable () chart lwidth = toRenderable layout where layout = layout1_title ^="Price History" $ layout1_background ^= solidFillStyle (opaque white) $ layout1_left_axis ^: laxis_override ^= axisTicksHide $ layout1_plots ^= [ Left (toPlot price1), Left (toPlot spots) ] $ setLayout1Foreground (opaque black) $ defaultLayout1 price1 = plot_lines_style ^= lineStyle $ plot_lines_values ^= [[ (d, v) | (d,v,_) <- prices1]] $ plot_lines_title ^= "price 1" $ defaultPlotLines spots = area_spots_4d_title ^= "random value" $ area_spots_4d_max_radius ^= 20 $ area_spots_4d_values ^= values $ defaultAreaSpots4D points = map (\ (d,v,z,t)-> (d,v) ) values values = [ (d, v, z, t) | ((d,v,_),z,t) <- zip3 prices1 zs ts ] zs,ts :: [Int] zs = randoms $ mkStdGen 0 ts = randomRs (-2,27) $ mkStdGen 1 lineStyle = line_width ^= 3 * lwidth $ line_color ^= opaque blue $ defaultPlotLines ^. plot_lines_style main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart 0.25) 320 240 "test14_small.png" main1 ["big"] = renderableToPNGFile (chart 0.25) 800 600 "test14_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test2.hs0000644000000000000000000000465012006610042013362 0ustar0000000000000000module Test2 where import Graphics.Rendering.Chart import Data.Time.LocalTime import Data.Colour import Data.Colour.Names import Data.Colour.SRGB import Data.Accessor import System.Environment(getArgs) import Prices(prices2) chart :: [(LocalTime,Double,Double)] -> Bool -> Double -> Renderable () chart prices showMinMax lwidth = toRenderable layout where lineStyle c = line_width ^= 3 * lwidth $ line_color ^= c $ defaultPlotLines ^. plot_lines_style limitLineStyle c = line_width ^= lwidth $ line_color ^= opaque c $ line_dashes ^= [5,10] $ defaultPlotLines ^. plot_lines_style price1 = plot_lines_style ^= lineStyle (opaque blue) $ plot_lines_values ^= [[ (d, v) | (d,v,_) <- prices]] $ plot_lines_title ^= "price 1" $ defaultPlotLines price2 = plot_lines_style ^= lineStyle (opaque green) $ plot_lines_values ^= [[ (d, v) | (d,_,v) <- prices]] $ plot_lines_title ^= "price 2" $ defaultPlotLines (min1,max1) = (minimum [v | (_,v,_) <- prices],maximum [v | (_,v,_) <- prices]) (min2,max2) = (minimum [v | (_,_,v) <- prices],maximum [v | (_,_,v) <- prices]) limits | showMinMax = [ Left $ hlinePlot "min/max" (limitLineStyle blue) min1, Left $ hlinePlot "" (limitLineStyle blue) max1, Right $ hlinePlot "min/max" (limitLineStyle green) min2, Right $ hlinePlot "" (limitLineStyle green) max2 ] | otherwise = [] bg = opaque $ sRGB 0 0 0.25 fg = opaque white fg1 = opaque $ sRGB 0.0 0.0 0.15 layout = layout1_title ^="Price History" $ layout1_background ^= solidFillStyle bg $ updateAllAxesStyles (axis_grid_style ^= solidLine 1 fg1) $ layout1_left_axis ^: laxis_override ^= axisGridHide $ layout1_right_axis ^: laxis_override ^= axisGridHide $ layout1_bottom_axis ^: laxis_override ^= axisGridHide $ layout1_plots ^= ([Left (toPlot price1), Right (toPlot price2)] ++ limits) $ layout1_grid_last ^= False $ setLayout1Foreground fg $ defaultLayout1 main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart prices2 True 0.25) 320 240 "test2_small.png" main1 ["big"] = renderableToPNGFile (chart prices2 True 0.25) 800 600 "test2_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test17.hs0000644000000000000000000000656512006610042013457 0ustar0000000000000000module Test17 where import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names import Data.Accessor import System.Random import System.Environment(getArgs) import ExampleStocks -- demonstrate Candles chart :: Double -> Renderable () chart lwidth = toRenderable layout where layout = layout1_title ^="Stock Prices" $ layout1_background ^= solidFillStyle (opaque white) $ layout1_left_axis ^: laxis_override ^= axisTicksHide $ layout1_plots ^= [ Right (toPlot msftArea) , Right (toPlot msftLine) , Right (toPlot msftCandle) , Left (toPlot aaplArea) , Left (toPlot aaplLine) , Left (toPlot aaplCandle) ] $ setLayout1Foreground (opaque black) $ defaultLayout1 aaplLine = plot_lines_style ^= lineStyle 2 green $ plot_lines_values ^= [[ (d, cl) | (d,(lo,op,cl,hi)) <- pricesAAPL]] $ plot_lines_title ^= "AAPL closing" $ defaultPlotLines msftLine = plot_lines_style ^= lineStyle 2 purple $ plot_lines_values ^= [[ (d, cl) | (d,(lo,op,cl,hi)) <- pricesMSFT]] $ plot_lines_title ^= "MSFT closing" $ defaultPlotLines aaplArea = plot_fillbetween_style ^= solidFillStyle (withOpacity green 0.4) $ plot_fillbetween_values ^= [ (d, (lo,hi)) | (d,(lo,op,cl,hi)) <- pricesAAPL] $ plot_fillbetween_title ^= "AAPL spread" $ defaultPlotFillBetween msftArea = plot_fillbetween_style ^= solidFillStyle (withOpacity purple 0.4) $ plot_fillbetween_values ^= [ (d, (lo,hi)) | (d,(lo,op,cl,hi)) <- pricesMSFT] $ plot_fillbetween_title ^= "MSFT spread" $ defaultPlotFillBetween aaplCandle = plot_candle_line_style ^= lineStyle 1 blue $ plot_candle_fill ^= True $ plot_candle_tick_length ^= 0 $ plot_candle_width ^= 2 $ plot_candle_values ^= [ Candle d lo op 0 cl hi | (d,(lo,op,cl,hi)) <- pricesAAPL] $ plot_candle_title ^= "AAPL candle" $ defaultPlotCandle msftCandle = plot_candle_line_style ^= lineStyle 1 red $ plot_candle_fill ^= True $ plot_candle_rise_fill_style ^= solidFillStyle (opaque pink) $ plot_candle_fall_fill_style ^= solidFillStyle (opaque red) $ plot_candle_tick_length ^= 0 $ plot_candle_width ^= 2 $ plot_candle_values ^= [ Candle d lo op 0 cl hi | (d,(lo,op,cl,hi)) <- pricesMSFT] $ plot_candle_title ^= "MSFT candle" $ defaultPlotCandle lineStyle n colour = line_width ^= n * lwidth $ line_color ^= opaque colour $ defaultPlotLines ^. plot_lines_style main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart 0.25) 320 240 "test1_small.png" main1 ["big"] = renderableToPNGFile (chart 0.25) 800 600 "test1_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test4.hs0000644000000000000000000000242412006610042013361 0ustar0000000000000000module Test4 where import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names import Data.Accessor import System.Environment(getArgs) chart :: Bool -> Bool -> Renderable () chart xrev yrev = toRenderable layout where points = plot_points_style ^= filledCircles 3 (opaque red) $ plot_points_values ^= [ (x, 10**x) | x <- [0.5,1,1.5,2,2.5 :: Double] ] $ plot_points_title ^= "values" $ defaultPlotPoints lines = plot_lines_values ^= [ [(x, 10**x) | x <- [0,3]] ] $ plot_lines_title ^= "values" $ defaultPlotLines layout = layout1_title ^= "Log/Linear Example" $ layout1_bottom_axis ^: laxis_title ^= "horizontal" $ layout1_bottom_axis ^: laxis_reverse ^= xrev $ layout1_left_axis ^: laxis_generate ^= autoScaledLogAxis defaultLogAxis $ layout1_left_axis ^: laxis_title ^= "vertical" $ layout1_left_axis ^: laxis_reverse ^= yrev $ layout1_plots ^= [Left (toPlot points), Left (toPlot lines) ] $ defaultLayout1 main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart False False) 320 240 "test4_small.png" main1 ["big"] = renderableToPNGFile (chart False False) 800 600 "test4_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test5.hs0000644000000000000000000000272012006610042013361 0ustar0000000000000000module Test5 where import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names import Data.Accessor import System.Random import System.Environment(getArgs) ---------------------------------------------------------------------- -- Example thanks to Russell O'Connor chart :: Double -> Renderable () chart lwidth = toRenderable (layout 1001 (trial bits) :: Layout1 Double LogValue) where bits = randoms $ mkStdGen 0 layout n t = layout1_title ^= "Simulation of betting on a biased coin" $ layout1_plots ^= [ Left (toPlot (plot "f=0.05" s1 n 0 (t 0.05))), Left (toPlot (plot "f=0.1" s2 n 0 (t 0.1))) ] $ defaultLayout1 plot tt s n m t = plot_lines_style ^= s $ plot_lines_values ^= [[(fromIntegral x, LogValue y) | (x,y) <- filter (\(x,_)-> x `mod` (m+1)==0) $ take n $ zip [0..] t]] $ plot_lines_title ^= tt $ defaultPlotLines b = 0.1 trial bits frac = scanl (*) 1 (map f bits) where f True = (1+frac*(1+b)) f False = (1-frac) s1 = solidLine lwidth $ opaque green s2 = solidLine lwidth $ opaque blue main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart 0.25) 320 240 "test5_small.png" main1 ["big"] = renderableToPNGFile (chart 0.25) 800 600 "test5_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test14.hs0000644000000000000000000000271312006610042013443 0ustar0000000000000000module Test14 where import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names import Data.Accessor import System.Random import System.Environment(getArgs) import Prices(prices1) -- demonstrate AreaSpots chart :: Double -> Renderable () chart lwidth = toRenderable layout where layout = layout1_title ^="Price History" $ layout1_background ^= solidFillStyle (opaque white) $ layout1_left_axis ^: laxis_override ^= axisTicksHide $ layout1_plots ^= [ Left (toPlot price1), Left (toPlot spots) ] $ setLayout1Foreground (opaque black) $ defaultLayout1 price1 = plot_lines_style ^= lineStyle $ plot_lines_values ^= [[ (d, v) | (d,v,_) <- prices1]] $ plot_lines_title ^= "price 1" $ defaultPlotLines spots = area_spots_title ^= "random value" $ area_spots_max_radius ^= 20 $ area_spots_values ^= values $ defaultAreaSpots points = map (\ (d,v,z)-> (d,v) ) values values = [ (d, v, z) | ((d,v,_),z) <- zip prices1 zs ] zs :: [Int] zs = randoms $ mkStdGen 0 lineStyle = line_width ^= 3 * lwidth $ line_color ^= opaque blue $ defaultPlotLines ^. plot_lines_style main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart 0.25) 320 240 "test14_small.png" main1 ["big"] = renderableToPNGFile (chart 0.25) 800 600 "test14_big.png" main = getArgs >>= main1 Chart-0.16/tests/ExampleStocks.hs0000644000000000000000000002246112006610042015143 0ustar0000000000000000module ExampleStocks where import Data.Time.Calendar import Data.Time.LocalTime mkDate :: Integer -> LocalTime mkDate jday = LocalTime (ModifiedJulianDay jday) midnight -- Price data imported from Yahoo: low, open, close, high pricesAAPL :: [(LocalTime,(Double,Double,Double,Double))] pricesMSFT :: [(LocalTime,(Double,Double,Double,Double))] pricesARMH :: [(LocalTime,(Double,Double,Double,Double))] pricesAAPL = [ (mkDate 55105,(180.7,185.35,180.86,186.22)) , (mkDate 55104,(182.61,186.13,185.35,186.45)) , (mkDate 55103,(184.31,186.73,185.38,187.4)) , (mkDate 55102,(183.33,183.87,186.15,186.68)) , (mkDate 55099,(181.44,182.01,182.37,185.5)) , (mkDate 55098,(182.77,187.2,183.82,187.7)) , (mkDate 55097,(185.03,185.4,185.5,188.9)) , (mkDate 55096,(182.85,185.19,184.48,185.38)) , (mkDate 55095,(181.62,184.29,184.02,185.16)) , (mkDate 55092,(184.76,185.83,185.02,186.55)) , (mkDate 55091,(181.97,181.98,184.55,186.79)) , (mkDate 55090,(177.88,177.99,181.87,182.75)) , (mkDate 55089,(173.59,174.04,175.16,175.65)) , (mkDate 55088,(170.25,170.83,173.72,173.9)) , (mkDate 55085,(170.87,172.91,172.16,173.18)) , (mkDate 55084,(170.81,172.06,172.56,173.25)) , (mkDate 55083,(169.7,172.78,171.14,174.47)) , (mkDate 55082,(172.0,172.98,172.93,173.14)) , (mkDate 55078,(167.09,167.28,170.31,170.7)) , (mkDate 55077,(165.0,166.44,166.55,167.1)) , (mkDate 55076,(164.11,164.62,165.18,167.61)) , (mkDate 55075,(164.94,167.99,165.3,170.0)) , (mkDate 55074,(166.5,168.16,168.21,168.85)) , (mkDate 55071,(168.53,172.27,170.05,172.49)) , (mkDate 55070,(164.83,168.75,169.45,169.57)) , (mkDate 55069,(166.76,168.92,167.41,169.55)) , (mkDate 55068,(169.13,169.46,169.4,170.94)) , (mkDate 55067,(168.27,170.12,169.06,170.71)) , (mkDate 55064,(166.8,167.65,169.22,169.37)) , (mkDate 55063,(164.61,164.98,166.33,166.72)) , (mkDate 55062,(162.45,162.75,164.6,165.3)) , (mkDate 55061,(161.41,161.63,164.0,164.24)) , (mkDate 55060,(159.42,163.55,159.59,163.59)) , (mkDate 55057,(165.53,167.94,166.78,168.23)) , (mkDate 55056,(166.5,166.65,168.42,168.67)) , (mkDate 55055,(162.46,162.55,165.31,166.71)) , (mkDate 55054,(161.88,163.69,162.83,164.38)) , (mkDate 55053,(163.66,165.66,164.72,166.6)) , (mkDate 55050,(164.8,165.49,165.51,166.6)) , (mkDate 55049,(163.09,165.58,163.91,166.51)) , (mkDate 55048,(164.21,165.75,165.11,167.39)) , (mkDate 55047,(164.21,164.93,165.55,165.57)) , (mkDate 55046,(164.87,165.21,166.43,166.64)) , (mkDate 55043,(162.91,162.99,163.39,165.0)) , (mkDate 55042,(161.5,161.7,162.79,164.72)) , (mkDate 55041,(158.25,158.9,160.03,160.45)) , (mkDate 55040,(157.6,158.88,160.0,160.1)) , (mkDate 55039,(157.26,160.17,160.1,160.88)) , (mkDate 55036,(156.5,156.95,159.99,160.0)) , (mkDate 55035,(155.56,156.63,157.82,158.44)) , (mkDate 55034,(156.11,157.79,156.74,158.73)) , (mkDate 55033,(149.75,153.29,151.51,153.43)) , (mkDate 55032,(150.89,153.27,152.91,155.04)) , (mkDate 55029,(148.63,149.08,151.75,152.02)) , (mkDate 55028,(145.57,145.76,147.52,148.02)) , (mkDate 55027,(144.32,145.04,146.88,147.0)) , (mkDate 55026,(141.16,142.03,142.27,143.18)) , (mkDate 55025,(137.53,139.54,142.34,142.34)) , (mkDate 55022,(136.32,136.34,138.52,138.97)) , (mkDate 55021,(135.93,137.76,136.36,137.99)) , (mkDate 55020,(134.42,135.92,137.22,138.04)) , (mkDate 55019,(135.18,138.48,135.4,139.68)) , (mkDate 55018,(136.25,138.7,138.61,138.99)) , (mkDate 55014,(139.79,141.25,140.02,142.83)) , (mkDate 55013,(142.52,143.5,142.83,144.66)) ] pricesMSFT = [ (mkDate 55105,(24.8,25.41,24.88,25.47)) , (mkDate 55104,(25.38,25.76,25.72,25.99)) , (mkDate 55103,(25.69,25.91,25.75,25.96)) , (mkDate 55102,(25.6,25.6,25.83,26.16)) , (mkDate 55099,(25.52,25.69,25.55,25.82)) , (mkDate 55098,(25.66,25.92,25.94,26.11)) , (mkDate 55097,(25.64,25.92,25.71,26.25)) , (mkDate 55096,(25.29,25.4,25.77,25.82)) , (mkDate 55095,(25.1,25.11,25.3,25.37)) , (mkDate 55092,(25.1,25.46,25.26,25.48)) , (mkDate 55091,(25.06,25.06,25.3,25.38)) , (mkDate 55090,(24.95,25.25,25.2,25.35)) , (mkDate 55089,(24.86,24.97,25.2,25.27)) , (mkDate 55088,(24.64,24.65,25.0,25.09)) , (mkDate 55085,(24.81,24.93,24.86,25.17)) , (mkDate 55084,(24.65,24.8,25.0,25.05)) , (mkDate 55083,(24.67,24.74,24.78,24.95)) , (mkDate 55082,(24.41,24.62,24.82,24.84)) , (mkDate 55078,(24.08,24.09,24.62,24.8)) , (mkDate 55077,(23.76,23.91,24.11,24.14)) , (mkDate 55076,(23.78,23.82,23.86,24.14)) , (mkDate 55075,(23.9,24.35,24.0,24.74)) , (mkDate 55074,(24.29,24.57,24.65,24.85)) , (mkDate 55071,(24.61,25.07,24.68,25.49)) , (mkDate 55070,(24.3,24.41,24.69,24.78)) , (mkDate 55069,(24.42,24.59,24.55,24.75)) , (mkDate 55068,(24.46,24.6,24.64,24.82)) , (mkDate 55067,(24.28,24.41,24.64,24.73)) , (mkDate 55064,(23.77,23.93,24.41,24.42)) , (mkDate 55063,(23.54,23.6,23.67,23.87)) , (mkDate 55062,(23.25,23.25,23.65,23.72)) , (mkDate 55061,(23.27,23.29,23.58,23.65)) , (mkDate 55060,(23.23,23.32,23.25,23.6)) , (mkDate 55057,(23.51,23.62,23.69,23.8)) , (mkDate 55056,(23.4,23.63,23.62,23.85)) , (mkDate 55055,(23.03,23.13,23.53,23.9)) , (mkDate 55054,(23.05,23.32,23.13,23.4)) , (mkDate 55053,(23.3,23.46,23.42,23.55)) , (mkDate 55050,(23.5,23.75,23.56,23.82)) , (mkDate 55049,(23.27,23.93,23.46,23.98)) , (mkDate 55048,(23.79,23.84,23.81,24.25)) , (mkDate 55047,(23.53,23.68,23.77,23.79)) , (mkDate 55046,(23.5,23.82,23.83,23.86)) , (mkDate 55043,(23.5,23.77,23.52,24.07)) , (mkDate 55042,(23.71,24.2,23.81,24.43)) , (mkDate 55041,(23.34,23.73,23.8,23.91)) , (mkDate 55040,(22.9,22.99,23.47,23.55)) , (mkDate 55039,(22.9,23.44,23.11,23.45)) , (mkDate 55036,(22.81,23.61,23.45,23.89)) , (mkDate 55035,(24.84,24.93,25.56,25.72)) , (mkDate 55034,(24.51,24.7,24.8,24.9)) , (mkDate 55033,(24.37,24.69,24.83,24.83)) , (mkDate 55032,(24.15,24.44,24.53,24.53)) , (mkDate 55029,(24.1,24.4,24.29,24.45)) , (mkDate 55028,(23.86,23.93,24.44,24.44)) , (mkDate 55027,(23.56,23.75,24.12,24.12)) , (mkDate 55026,(22.86,23.2,23.11,23.22)) , (mkDate 55025,(22.14,22.42,23.23,23.29)) , (mkDate 55022,(22.15,22.19,22.39,22.54)) , (mkDate 55021,(22.37,22.65,22.44,22.81)) , (mkDate 55020,(22.0,22.31,22.56,22.69)) , (mkDate 55019,(22.46,23.08,22.53,23.14)) , (mkDate 55018,(22.87,23.21,23.2,23.28)) , (mkDate 55014,(23.21,23.76,23.37,24.04)) , (mkDate 55013,(23.96,24.05,24.04,24.3)) ] pricesARMH = [ (mkDate 55105,(6.65,6.83,6.65,6.86)) , (mkDate 55104,(6.87,7.0,7.0,7.02)) , (mkDate 55103,(6.88,6.92,6.95,6.97)) , (mkDate 55102,(6.62,6.63,6.81,6.82)) , (mkDate 55099,(6.69,6.88,6.72,6.88)) , (mkDate 55098,(6.55,6.69,6.64,6.88)) , (mkDate 55097,(6.8,6.87,6.8,6.94)) , (mkDate 55096,(6.67,6.68,6.74,6.78)) , (mkDate 55095,(6.62,6.67,6.7,6.77)) , (mkDate 55092,(6.63,6.71,6.7,6.76)) , (mkDate 55091,(6.64,6.7,6.67,6.76)) , (mkDate 55090,(6.76,6.84,6.77,6.85)) , (mkDate 55089,(6.69,6.73,6.84,6.9)) , (mkDate 55088,(6.73,6.74,6.8,6.81)) , (mkDate 55085,(6.84,7.05,6.87,7.07)) , (mkDate 55084,(6.65,6.7,6.94,6.97)) , (mkDate 55083,(6.65,6.71,6.7,6.75)) , (mkDate 55082,(6.56,6.58,6.65,6.68)) , (mkDate 55078,(6.16,6.18,6.39,6.41)) , (mkDate 55077,(6.11,6.19,6.21,6.24)) , (mkDate 55076,(6.03,6.07,6.09,6.14)) , (mkDate 55075,(6.14,6.22,6.24,6.31)) , (mkDate 55074,(6.3,6.45,6.35,6.45)) , (mkDate 55071,(6.4,6.5,6.47,6.56)) , (mkDate 55070,(6.13,6.18,6.35,6.39)) , (mkDate 55069,(6.1,6.12,6.16,6.2)) , (mkDate 55068,(6.14,6.3,6.17,6.3)) , (mkDate 55067,(6.19,6.29,6.21,6.34)) , (mkDate 55064,(6.25,6.32,6.3,6.38)) , (mkDate 55063,(6.18,6.2,6.25,6.27)) , (mkDate 55062,(6.09,6.11,6.19,6.22)) , (mkDate 55061,(6.14,6.14,6.23,6.28)) , (mkDate 55060,(5.91,6.02,5.98,6.04)) , (mkDate 55057,(6.04,6.15,6.2,6.21)) , (mkDate 55056,(6.1,6.18,6.22,6.26)) , (mkDate 55055,(6.07,6.07,6.22,6.3)) , (mkDate 55054,(6.09,6.23,6.14,6.23)) , (mkDate 55053,(6.19,6.39,6.23,6.4)) , (mkDate 55050,(6.25,6.31,6.32,6.41)) , (mkDate 55049,(6.2,6.42,6.24,6.42)) , (mkDate 55048,(6.4,6.55,6.46,6.55)) , (mkDate 55047,(6.5,6.52,6.67,6.7)) , (mkDate 55046,(6.5,6.51,6.58,6.6)) , (mkDate 55043,(6.3,6.34,6.39,6.43)) , (mkDate 55042,(6.42,6.47,6.46,6.64)) , (mkDate 55041,(6.14,6.37,6.22,6.49)) , (mkDate 55040,(6.28,6.32,6.52,6.56)) , (mkDate 55039,(6.41,6.47,6.49,6.63)) , (mkDate 55036,(6.27,6.36,6.44,6.44)) , (mkDate 55035,(6.47,6.48,6.52,6.55)) , (mkDate 55034,(6.38,6.41,6.47,6.51)) , (mkDate 55033,(6.27,6.45,6.41,6.46)) , (mkDate 55032,(6.32,6.44,6.45,6.48)) , (mkDate 55029,(6.23,6.25,6.37,6.45)) , (mkDate 55028,(6.24,6.29,6.35,6.39)) , (mkDate 55027,(6.37,6.53,6.45,6.6)) , (mkDate 55026,(6.12,6.13,6.19,6.23)) , (mkDate 55025,(5.98,6.02,6.12,6.13)) , (mkDate 55022,(5.93,5.96,6.08,6.12)) , (mkDate 55021,(5.74,5.8,5.97,6.0)) , (mkDate 55020,(5.61,5.74,5.69,5.82)) , (mkDate 55019,(5.68,5.82,5.69,5.84)) , (mkDate 55018,(5.77,5.84,5.91,5.93)) , (mkDate 55014,(5.89,6.03,5.94,6.06)) , (mkDate 55013,(5.93,5.98,5.95,6.03)) ] Chart-0.16/tests/Test7.hs0000644000000000000000000000200312006610042013355 0ustar0000000000000000module Test7 where import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names import Data.Accessor import System.Environment(getArgs) chart = toRenderable layout where vals :: [(Double,Double,Double,Double)] vals = [ (x,sin (exp x),sin x/2,cos x/10) | x <- [1..20]] bars = plot_errbars_values ^= [symErrPoint x y dx dy | (x,y,dx,dy) <- vals] $ plot_errbars_title ^="test" $ defaultPlotErrBars points = plot_points_style ^= filledCircles 2 (opaque red) $ plot_points_values ^= [(x,y) | (x,y,dx,dy) <- vals] $ plot_points_title ^= "test data" $ defaultPlotPoints layout = layout1_title ^= "Error Bars" $ layout1_plots ^= [Left (toPlot bars), Left (toPlot points)] $ defaultLayout1 main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile chart 320 240 "test7_small.png" main1 ["big"] = renderableToPNGFile chart 800 600 "test7_big.png" main = getArgs >>= main1 Chart-0.16/tests/Test9.hs0000644000000000000000000000241612006610042013367 0ustar0000000000000000module Test9 where import Graphics.Rendering.Chart import Data.Colour import Data.Colour.Names import Data.Accessor import System.Environment(getArgs) chart borders = toRenderable layout where layout = layout1_title ^= "Sample Bars" ++ btitle $ layout1_title_style ^: font_size ^= 10 $ layout1_bottom_axis ^: laxis_generate ^= autoIndexAxis alabels $ layout1_left_axis ^: laxis_override ^= (axisGridHide.axisTicksHide) $ layout1_plots ^= [ Left (plotBars bars2) ] $ defaultLayout1 :: Layout1 PlotIndex Double bars2 = plot_bars_titles ^= ["Cash","Equity"] $ plot_bars_values ^= addIndexes [[20,45],[45,30],[30,20],[70,25]] $ plot_bars_style ^= BarsClustered $ plot_bars_spacing ^= BarsFixGap 30 5 $ plot_bars_item_styles ^= map mkstyle (cycle defaultColorSeq) $ defaultPlotBars alabels = [ "Jun", "Jul", "Aug", "Sep", "Oct" ] btitle = if borders then "" else " (no borders)" bstyle = if borders then Just (solidLine 1.0 $ opaque black) else Nothing mkstyle c = (solidFillStyle c, bstyle) main1 :: [String] -> IO (PickFn ()) main1 ["small"] = renderableToPNGFile (chart True) 320 240 "test9_small.png" main1 ["big"] = renderableToPNGFile (chart True) 800 600 "test9_big.png" main = getArgs >>= main1