Chart 0.10.3 → 0.11
raw patch · 9 files changed
+229/−123 lines, 9 filesdep +colour
Dependencies added: colour
Files
- Chart.cabal +2/−2
- Graphics/Rendering/Chart/Axis.hs +4/−2
- Graphics/Rendering/Chart/Layout.hs +19/−13
- Graphics/Rendering/Chart/Legend.hs +3/−3
- Graphics/Rendering/Chart/Pie.hs +9/−7
- Graphics/Rendering/Chart/Plot.hs +76/−30
- Graphics/Rendering/Chart/Simple.hs +4/−4
- Graphics/Rendering/Chart/Types.hs +30/−36
- tests/test.hs +82/−26
Chart.cabal view
@@ -1,5 +1,5 @@ Name: Chart-Version: 0.10.3+Version: 0.11 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2009@@ -22,7 +22,7 @@ Build-depends: base >= 3, old-locale, time, mtl, array else Build-depends: base < 3- Build-depends: gtk >= 0.9.11, cairo >= 0.9.11, time, mtl, array, data-accessor == 0.2.*, data-accessor-template >= 0.2.1.1 && < 0.3+ Build-depends: gtk >= 0.9.11, 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/Axis.hs view
@@ -88,6 +88,8 @@ import Control.Monad import Data.List import Data.Accessor.Template+import Data.Colour (opaque)+import Data.Colour.Names (black, lightgrey) import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Renderable@@ -425,8 +427,8 @@ ---------------------------------------------------------------------- -defaultAxisLineStyle = solidLine 1 black-defaultGridLineStyle = dashedLine 1 [5,5] grey8+defaultAxisLineStyle = solidLine 1 $ opaque black+defaultGridLineStyle = dashedLine 1 [5,5] $ opaque lightgrey defaultAxisStyle = AxisStyle { axis_line_style_ = defaultAxisLineStyle,
Graphics/Rendering/Chart/Layout.hs view
@@ -73,6 +73,8 @@ 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.@@ -198,15 +200,15 @@ legends = gridToRenderable (besideN [ tval $ mkLegend lefts, weights (1,1) $ tval $ emptyRenderable, tval $ mkLegend rights ])- lefts = [ p | (Left p) <- (layout1_plots_ l) ] - rights = [ p | (Right p) <- (layout1_plots_ l) ] + lefts = concat [ plot_legend_ p | (Left p) <- (layout1_plots_ l) ] + rights = concat [ plot_legend_ p | (Right p) <- (layout1_plots_ l) ] - mkLegend plots = case (layout1_legend_ l) of+ mkLegend vals = case (layout1_legend_ l) of Nothing -> emptyRenderable- (Just ls) -> case plots of+ (Just ls) -> case filter ((/="").fst) vals of [] -> emptyRenderable- ps -> addMargins (0,lm,lm,lm)- (mapPickFn L1P_Legend $ legendToRenderable (Legend True ls ps))+ lvs -> addMargins (0,lm,lm,lm)+ (mapPickFn L1P_Legend $ legendToRenderable (Legend True ls lvs)) lm = layout1_margin_ l @@ -235,7 +237,11 @@ rPlot1 (Just (AxisT _ xs xrev xaxis)) (Just (AxisT _ ys yrev yaxis)) p = let xrange = if xrev then (w, 0) else (0,w) yrange = if yrev then (0, h) else (h, 0)- pmfn (x,y) = Point (axis_viewport_ xaxis xrange x) (axis_viewport_ yaxis yrange y)+ pmfn (x,y) = Point (mapv xrange (axis_viewport_ xaxis xrange) x)+ (mapv yrange (axis_viewport_ yaxis yrange) y)+ mapv (min,max) _ LMin = min+ mapv (min,max) _ LMax = max+ mapv _ f (LValue v) = f v in plot_render_ p pmfn rPlot1 _ _ _ = return () @@ -273,14 +279,14 @@ 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,_) <- plot_all_points_ p]- yvals0 = [ y | (Left p) <- plots, (_,y) <- plot_all_points_ p]- xvals1 = [ x | (Right p) <- plots, (x,_) <- plot_all_points_ p]- yvals1 = [ y | (Right p) <- plots, (_,y) <- plot_all_points_ p]+ 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 white,+ layout1_background_ = solidFillStyle $ opaque white, layout1_plot_background_ = Nothing, layout1_title_ = "",@@ -325,7 +331,7 @@ (layout1_right_axis .> laxis_style ^: uf) -- | Helper to set the forground color uniformly on a Layout1-setLayout1Foreground :: Color -> Layout1 x y -> Layout1 x y+setLayout1Foreground :: AlphaColour Double -> Layout1 x y -> Layout1 x y setLayout1Foreground fg = updateAllAxesStyles ( (axis_line_style .> line_color ^= fg). (axis_label_style .> font_color ^= fg)
Graphics/Rendering/Chart/Legend.hs view
@@ -35,18 +35,18 @@ legend_plot_size_ :: Double } -data Legend x y = Legend Bool LegendStyle [Plot x y]+data Legend x y = Legend Bool LegendStyle [(String, Rect -> CRender ())] instance ToRenderable (Legend x y) where toRenderable = setPickFn nullPickFn.legendToRenderable legendToRenderable :: Legend x y -> Renderable String-legendToRenderable (Legend _ ls plots) = gridToRenderable grid+legendToRenderable (Legend _ ls lvs) = gridToRenderable grid where grid = besideN $ intersperse ggap1 (map (tval.rf) ps) ps :: [(String, [Rect -> CRender ()])]- ps = join_nub (concatMap plot_legend_ plots)+ ps = join_nub lvs rf (title,rfs) = gridToRenderable grid1 where
Graphics/Rendering/Chart/Pie.hs view
@@ -56,7 +56,9 @@ import Data.List import Data.Bits import Data.Accessor.Template -import Control.Monad +import Data.Colour +import Data.Colour.Names (black, white) +import Control.Monad import Graphics.Rendering.Chart.Types import Graphics.Rendering.Chart.Legend @@ -73,7 +75,7 @@ data PieChart = PieChart { pie_data_ :: [PieItem], - pie_colors_ :: [Color], + pie_colors_ :: [AlphaColour Double], pie_label_style_ :: CairoFontStyle, pie_label_line_style_ :: CairoLineStyle, pie_start_angle_ :: Double @@ -90,14 +92,14 @@ pie_data_ = [], pie_colors_ = defaultColorSeq, pie_label_style_ = defaultFontStyle, - pie_label_line_style_ = solidLine 1 black, + pie_label_line_style_ = solidLine 1 $ opaque black, pie_start_angle_ = 0 } defaultPieItem = PieItem "" 0 0 defaultPieLayout = PieLayout { - pie_background_ = solidFillStyle white, + pie_background_ = solidFillStyle $ opaque white, pie_title_ = "", pie_title_style_ = defaultFontStyle{font_size_=15, font_weight_=C.FontWeightBold}, pie_plot_ = defaultPieChart, @@ -147,7 +149,7 @@ content = let total = sum (map pitem_value_ (pie_data_ p)) in [ pi{pitem_value_=pitem_value_ pi/total} | pi <- pie_data_ p ] - paint :: Point -> Double -> Double -> (Color,PieItem) -> CRender Double + paint :: 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) @@ -178,8 +180,8 @@ let p2 = p1 `pvadd` (Vector (offset label_rgap) 0) drawText anchor VTA_Bottom p2 name - pieSlice :: Point -> Double -> Double -> Color -> CRender () - pieSlice (Point x y) a1 a2 color = c $ do + 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
Graphics/Rendering/Chart/Plot.hs view
@@ -57,7 +57,11 @@ plot_lines_title, plot_lines_style, plot_lines_values,+ plot_lines_limit_values, + hlinePlot,+ vlinePlot,+ plot_render, plot_legend, plot_all_points,@@ -92,6 +96,9 @@ import Control.Monad import Data.List import Data.Accessor.Template+import Data.Colour+import Data.Colour.SRGB (sRGB)+import Data.Colour.Names -- | Interface to control plotting on a 2D area. data Plot x y = Plot {@@ -107,7 +114,7 @@ -- | All of the model space coordinates to be plotted. These are -- used to autoscale the axes where necessary.- plot_all_points_ :: [(x,y)]+ plot_all_points_ :: ([x],[y]) } -- | a type class abstracting the conversion of a value to a Plot.@@ -116,12 +123,18 @@ ---------------------------------------------------------------------- +mapXY :: PointMapFn x y -> ((x,y) -> Point)+mapXY f (x,y) = f (LValue x, LValue y)++----------------------------------------------------------------------+ -- | 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,- plot_lines_values_ :: [[(x,y)]]+ plot_lines_values_ :: [[(x,y)]],+ plot_lines_limit_values_ :: [[(Limit x, Limit y)]] } @@ -129,15 +142,20 @@ toPlot p = Plot { plot_render_ = renderPlotLines p, plot_legend_ = [(plot_lines_title_ p, renderPlotLegendLines p)],- plot_all_points_ = concat (plot_lines_values_ 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 (plot_lines_values_ p)+ mapM_ (drawLines (mapXY pmap)) (plot_lines_values_ p)+ mapM_ (drawLines pmap) (plot_lines_limit_values_ p) where- drawLines (p:ps) = do+ drawLines pmap (p:ps) = do moveTo (pmap p) mapM_ (\p -> lineTo (pmap p)) ps c $ C.stroke@@ -150,7 +168,7 @@ lineTo (Point (p_x p2) y) c $ C.stroke -defaultPlotLineStyle = (solidLine 1 blue){ +defaultPlotLineStyle = (solidLine 1 $ opaque blue){ line_cap_ = C.LineCapRound, line_join_ = C.LineJoinRound }@@ -158,8 +176,26 @@ defaultPlotLines = PlotLines { plot_lines_title_ = "", plot_lines_style_ = defaultPlotLineStyle,- plot_lines_values_ = []+ 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)]]+ }+ ---------------------------------------------------------------------- -- | Value defining a series of datapoints, and a style in@@ -175,13 +211,16 @@ toPlot p = Plot { plot_render_ = renderPlotPoints p, plot_legend_ = [(plot_points_title_ p, renderPlotLegendPoints p)],- plot_all_points_ = plot_points_values_ 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)+ mapM_ (drawPoint.pmap') (plot_points_values_ p) where+ pmap' = mapXY pmap (CairoPointStyle drawPoint) = (plot_points_style_ p) @@ -229,8 +268,9 @@ lineTo p0 c $ C.fill where- (p0:p1s) = map pmap [ (x,y1) | (x,(y1,y2)) <- vs ]- p2s = map pmap [ (x,y2) | (x,(y1,y2)) <- vs ]+ 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@@ -238,15 +278,16 @@ rectPath r c $ C.fill -plotAllPointsFillBetween :: PlotFillBetween x y -> [(x,y)]-plotAllPointsFillBetween p = concat [ [(x, y1), (x, y2)]- | (x,(y1,y2)) <- plot_fillbetween_values_ p]+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 { plot_fillbetween_title_ = "",- plot_fillbetween_style_=solidFillStyle (Color 0.5 0.5 1.0),- plot_fillbetween_values_=[]+ plot_fillbetween_style_ = solidFillStyle (opaque $ sRGB 0.5 0.5 1.0),+ plot_fillbetween_values_= [] } ----------------------------------------------------------------------@@ -284,10 +325,11 @@ toPlot p = Plot { plot_render_ = renderPlotErrBars p, plot_legend_ = [(plot_errbars_title_ p,renderPlotLegendErrBars p)],- plot_all_points_ = concat- [[((ev_low x),(ev_low y)), ((ev_high x),(ev_high y))]- | ErrPoint x y <- plot_errbars_values_ 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@@ -295,10 +337,11 @@ 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)+ 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@@ -331,7 +374,7 @@ defaultPlotErrBars = PlotErrBars { plot_errbars_title_ = "",- plot_errbars_line_style_ = solidLine 1 blue,+ plot_errbars_line_style_ = solidLine 1 $ opaque blue, plot_errbars_tick_length_ = 3, plot_errbars_overhang_ = 0, plot_errbars_values_ = []@@ -392,7 +435,7 @@ } where istyles = map mkstyle defaultColorSeq- mkstyle c = (solidFillStyle c,Just (solidLine 1.0 black))+ mkstyle c = (solidFillStyle c,Just (solidLine 1.0 $ opaque black)) plotBars :: (BarsPlotValue y) => PlotBars x y -> Plot x y plotBars p = Plot {@@ -432,8 +475,8 @@ c $ C.stroke barPath xos x y0 y1 = do- let (Point x' y') = pmap (x,y1)- let (Point _ y0') = pmap (x,y0)+ 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@@ -447,19 +490,22 @@ minXInterval = minimum $ zipWith (-) (tail xs) xs where - xs = nub $ sort $ map (p_x.pmap) (allBarPoints p)+ xs = nub $ sort $ map (\x-> p_x (pmap' (x,barsReference))) (fst (allBarPoints p)) nys = maximum [ length ys | (x,ys) <- vals ]+ + pmap' = mapXY pmap 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 :: (BarsPlotValue y) => PlotBars x y -> ([x],[y]) allBarPoints p = case (plot_bars_style_ p) of- BarsClustered -> concat [ (x,y0):[(x,y) | y <- ys ] | (x,ys) <- plot_bars_values_ p ]- BarsStacked -> concat [ (x,y0):[(x,y) | y <- stack ys ] | (x,ys) <- plot_bars_values_ p ]+ BarsClustered -> ( [x| (x,_) <- pts], concat [ys| (_,ys) <- pts] )+ BarsStacked -> ( [x| (x,_) <- pts], concat [stack ys | (_,ys) <- pts] ) where+ pts = plot_bars_values_ p y0 = plot_bars_reference_ p stack :: (BarsPlotValue y) => [y] -> [y]
Graphics/Rendering/Chart/Simple.hs view
@@ -36,15 +36,15 @@ ) where import Data.Maybe ( catMaybes )+import Data.Colour+import Data.Colour.Names import Graphics.Rendering.Chart import Graphics.Rendering.Chart.Gtk -styleColor :: Int -> Color+styleColor :: Int -> AlphaColour Double styleColor ind = colorSequence !! ind- where colorSequence = cycle [Color 0 0 1,Color 1 0 0,Color 0 1 0,- Color 1 1 0,Color 0 1 1,Color 1 0 1,- Color 0 0 0]+ where colorSequence = cycle $ map opaque [blue, red, green, yellow, cyan, magenta, black] styleSymbol :: Int -> PlotKind styleSymbol ind = symbolSequence !! ind
Graphics/Rendering/Chart/Types.hs view
@@ -41,6 +41,7 @@ within, RectEdge(..),+ Limit(..), PointMapFn, preserveCState,@@ -53,11 +54,8 @@ isValidNumber, maybeM, - black, grey8, white, red, green, blue, defaultColorSeq,- - Color(..),- color,+ setSourceColor, CairoLineStyle(..),@@ -113,6 +111,9 @@ import Control.Monad.Reader import Data.Accessor import Data.Accessor.Template+import Data.Colour+import Data.Colour.SRGB+import Data.Colour.Names -- | A point in two dimensions data Point = Point {@@ -125,15 +126,6 @@ v_y :: Double } deriving Show -data Color = Color {- c_r :: Double,- c_g :: Double,- c_b :: Double-}--color :: Int -> Int -> Int -> Color-color ri gi bi = Color (fromIntegral ri/255) (fromIntegral gi/255) (fromIntegral bi/255)- -- | scale a vector by a constant vscale :: Double -> Vector -> Vector vscale c (Vector x y) = (Vector (x*c) (y*c))@@ -150,8 +142,11 @@ 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 = (x,y) -> Point+type PointMapFn x y = (Limit x, Limit y) -> Point -- | A rectangle is defined by two points data Rect = Rect Point Point@@ -210,7 +205,7 @@ -- | Data type for the style of a line data CairoLineStyle = CairoLineStyle { line_width_ :: Double,- line_color_ :: Color,+ line_color_ :: AlphaColour Double, line_dashes_ :: [Double], line_cap_ :: C.LineCap, line_join_ :: C.LineJoin@@ -228,20 +223,15 @@ font_size_ :: Double, font_slant_ :: C.FontSlant, font_weight_ :: C.FontWeight,- font_color_ :: Color+ font_color_ :: AlphaColour Double } type Range = (Double,Double) type RectSize = (Double,Double) -black = Color 0 0 0-grey8 = Color 0.8 0.8 0.8-white = Color 1 1 1-red = Color 1 0 0-green = Color 0 1 0-blue = Color 0 0 1+defaultColorSeq :: [AlphaColour Double]+defaultColorSeq = cycle $ map opaque [blue, red, green, yellow, cyan, magenta] -defaultColorSeq = cycle [blue,red,green, Color 1 1 0,Color 0 1 1,Color 1 0 1 ] ---------------------------------------------------------------------- -- Assorted helper functions in Cairo Usage @@ -306,8 +296,12 @@ setFillStyle (CairoFillStyle s) = s -setSourceColor (Color r g b) = C.setSourceRGB r g b+colourChannel :: (Floating a, Ord a) => AlphaColour a -> Colour a+colourChannel c = darken (recip (alphaChannel c)) (c `over` black) +setSourceColor c = let (RGB r g b) = toSRGB $ colourChannel c+ in C.setSourceRGBA r g b (alphaChannel c)+ -- | Return the bounding rectancgle for a text string rendered -- in the current context. textSize :: String -> CRender RectSize@@ -351,7 +345,7 @@ filledCircles :: Double -- ^ radius of circle- -> Color -- ^ colour+ -> AlphaColour Double -- ^ colour -> CairoPointStyle filledCircles radius cl = CairoPointStyle rf where@@ -365,7 +359,7 @@ hollowCircles :: Double -- ^ radius of circle -> Double -- ^ thickness of line- -> Color+ -> AlphaColour Double -> CairoPointStyle hollowCircles radius w cl = CairoPointStyle rf where@@ -382,7 +376,7 @@ -> Double -- ^ thickness of line -> Int -- ^ Number of vertices -> Bool -- ^ Is right-side-up?- -> Color+ -> AlphaColour Double -> CairoPointStyle hollowPolygon radius w sides isrot cl = CairoPointStyle rf where rf p =@@ -403,7 +397,7 @@ Double -- ^ radius of circle -> Int -- ^ Number of vertices -> Bool -- ^ Is right-side-up?- -> Color+ -> AlphaColour Double -> CairoPointStyle filledPolygon radius sides isrot cl = CairoPointStyle rf where rf p =@@ -422,7 +416,7 @@ plusses :: Double -- ^ radius of circle -> Double -- ^ thickness of line- -> Color+ -> AlphaColour Double -> CairoPointStyle plusses radius w cl = CairoPointStyle rf where rf p = do (Point x y ) <- alignp p@@ -438,7 +432,7 @@ exes :: Double -- ^ radius of circle -> Double -- ^ thickness of line- -> Color+ -> AlphaColour Double -> CairoPointStyle exes radius w cl = CairoPointStyle rf where rad = radius / sqrt 2@@ -455,7 +449,7 @@ stars :: Double -- ^ radius of circle -> Double -- ^ thickness of line- -> Color + -> AlphaColour Double -> CairoPointStyle stars radius w cl = CairoPointStyle rf where rad = radius / sqrt 2@@ -475,31 +469,31 @@ solidLine :: Double -- ^ width of line- -> Color+ -> 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- -> Color+ -> AlphaColour Double -> CairoLineStyle dashedLine w ds cl = CairoLineStyle w cl ds C.LineCapButt C.LineJoinMiter solidFillStyle ::- Color+ AlphaColour Double -> CairoFillStyle solidFillStyle cl = CairoFillStyle fn where fn = c $ setSourceColor cl -defaultPointStyle = filledCircles 1 white+defaultPointStyle = filledCircles 1 $ opaque white defaultFontStyle = CairoFontStyle { font_name_ = "sans", font_size_ = 10, font_slant_ = C.FontSlantNormal, font_weight_ = C.FontWeightNormal,- font_color_ = black+ font_color_ = opaque black } isValidNumber v = not (isNaN v) && not (isInfinite v)
tests/test.hs view
@@ -11,9 +11,11 @@ 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 Debug.Trace import Control.Monad import Prices @@ -25,23 +27,23 @@ chooseLineWidth PS = 0.25 chooseLineWidth SVG = 0.25 -green1 = (Color 0.5 1 0.5)-red1 = (Color 0.5 0.5 1)-fwhite = solidFillStyle white-fparchment = solidFillStyle (color 255 250 230) +green1 = opaque $ sRGB 0.5 1 0.5+red1 = opaque $ sRGB 0.5 0.5 1+fwhite = solidFillStyle $ opaque white+fparchment = solidFillStyle $ opaque $ sRGB 1.0 0.99 0.90 ---------------------------------------------------------------------- test1Layout otype = layout where am :: Double -> Double- am x = (sin (x*3.14159/45) + 1) / 2 * (sin (x*3.14159/5))+ 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 lineWidth blue+ $ plot_lines_style ^= solidLine lineWidth (opaque blue) $ plot_lines_title ^="am" $ defaultPlotLines - sinusoid2 = plot_points_style ^= filledCircles 2 red+ sinusoid2 = plot_points_style ^= filledCircles 2 (opaque red) $ plot_points_values ^= [ (x,(am x)) | x <- [0,7..400]] $ plot_points_title ^="am points" $ defaultPlotPoints@@ -109,35 +111,48 @@ . (laxis_override ^= (axisGridHide.axisTicksHide.axisLabelsHide)) -----------------------------------------------------------------------test2 :: [(Int,Int,Int,Double,Double)] -> OutputType -> Renderable ()-test2 prices otype = toRenderable layout+test2 :: [(Int,Int,Int,Double,Double)] -> Bool -> OutputType -> Renderable ()+test2 prices showMinMax otype = toRenderable layout where lineStyle c = line_width ^= 3 * chooseLineWidth otype $ line_color ^= c $ defaultPlotLines ^. plot_lines_style - price1 = plot_lines_style ^= lineStyle blue+ limitLineStyle c = line_width ^= chooseLineWidth otype+ $ line_color ^= opaque c+ $ line_dashes ^= [5,10]+ $ defaultPlotLines ^. plot_lines_style++ price1 = plot_lines_style ^= lineStyle (opaque blue) $ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,v,_) <- prices]] $ plot_lines_title ^= "price 1" $ defaultPlotLines - price2 = plot_lines_style ^= lineStyle green+ price2 = plot_lines_style ^= lineStyle (opaque green) $ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,_,v) <- prices]] $ plot_lines_title ^= "price 2" $ defaultPlotLines - bg = Color 0 0 0.25- fg = Color 1 1 1- fg1 = Color 0.0 0.0 0.15+ (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)]+ $ layout1_plots ^= ([Left (toPlot price1), Right (toPlot price2)] ++ limits) $ layout1_grid_last ^= False $ setLayout1Foreground fg $ defaultLayout1@@ -170,7 +185,7 @@ test4 xrev yrev otype = toRenderable layout where - points = plot_points_style ^= filledCircles 3 red+ points = plot_points_style ^= filledCircles 3 (opaque red) $ plot_points_values ^= [ (x, LogValue (10**x)) | x <- [0.5,1,1.5,2,2.5] ] $ plot_points_title ^= "values" $ defaultPlotPoints@@ -216,8 +231,8 @@ f True = (1+frac*(1+b)) f False = (1-frac) - s1 = solidLine lineWidth green- s2 = solidLine lineWidth blue+ s1 = solidLine lineWidth $ opaque green+ s2 = solidLine lineWidth $ opaque blue lineWidth = chooseLineWidth otype @@ -246,7 +261,7 @@ $ plot_errbars_title ^="test" $ defaultPlotErrBars - points = plot_points_style ^= filledCircles 2 red+ points = plot_points_style ^= filledCircles 2 (opaque red) $ plot_points_values ^= [(x,y) | (x,y,dx,dy) <- vals] $ plot_points_title ^= "test" $ defaultPlotPoints@@ -327,7 +342,46 @@ $ plot_bars_values ^= addIndexes [[20,45],[45,30],[30,20],[70,25]] $ defaultPlotBars +------------------------------------------------------------------------------- +test10 :: [(Int,Int,Int,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 ^= [[ ((date d m y), v) | (d,m,y,v,_) <- prices]]+ $ plot_lines_title ^= "price 1"+ $ defaultPlotLines++ price1_area = plot_fillbetween_values ^= [((date d m y), (v * 0.95, v * 1.05)) | (d,m,y,v,_) <- prices]+ $ plot_fillbetween_style ^= solidFillStyle (withOpacity blue 0.2)+ $ defaultPlotFillBetween++ price2 = plot_lines_style ^= lineStyle (opaque red)+ $ plot_lines_values ^= [[ ((date d m y), v) | (d,m,y,_,v) <- prices]]+ $ plot_lines_title ^= "price 2"+ $ defaultPlotLines++ price2_area = plot_fillbetween_values ^= [((date d m y), (v * 0.95, v * 1.05)) | (d,m,y,_,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 to display labels with all combinations -- of anchors@@ -338,8 +392,8 @@ s = "Labelling" hs = [HTA_Left, HTA_Centre, HTA_Right] vs = [VTA_Top, VTA_Centre, VTA_Bottom]- fwhite = solidFillStyle white- fblue = solidFillStyle (Color 0.8 0.8 1)+ 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,@@ -356,10 +410,11 @@ allTests = [ ("test1", test1) , ("test1a", test1a)- , ("test2a", test2 prices)- , ("test2b", test2 (filterPrices (date 1 1 2005) (date 31 12 2005)))- , ("test2c", test2 (filterPrices (date 1 5 2005) (date 1 7 2005)))- , ("test2d", test2 (filterPrices (date 1 1 2006) (date 10 1 2006)))+ , ("test2a", test2 prices False)+ , ("test2b", test2 (filterPrices (date 1 1 2005) (date 31 12 2005)) False)+ , ("test2c", test2 (filterPrices (date 1 5 2005) (date 1 7 2005)) False)+ , ("test2d", test2 (filterPrices (date 1 1 2006) (date 10 1 2006)) False)+ , ("test2e", test2 (filterPrices (date 1 8 2005) (date 31 8 2005)) True) , ("test3", test3) , ("test4a", test4 False False) , ("test4b", test4 True False)@@ -369,6 +424,7 @@ , ("test7", test7) , ("test8", test8) , ("test9", test9)+ , ("test10", test10 (filterPrices (date 1 1 2005) (date 31 12 2005))) , ("misc1", misc1 0) , ("misc1a", misc1 45) ]