diff --git a/Chart.cabal b/Chart.cabal --- a/Chart.cabal +++ b/Chart.cabal @@ -1,5 +1,5 @@ Name: Chart -Version: 0.15 +Version: 0.16 License: BSD3 License-file: LICENSE Copyright: Tim Docker, 2006-2010 @@ -70,3 +70,4 @@ Graphics.Rendering.Chart.Plot.Lines, Graphics.Rendering.Chart.Plot.Pie, Graphics.Rendering.Chart.Plot.Points + Graphics.Rendering.Chart.SparkLine diff --git a/Graphics/Rendering/Chart/Axis/Floating.hs b/Graphics/Rendering/Chart/Axis/Floating.hs --- a/Graphics/Rendering/Chart/Axis/Floating.hs +++ b/Graphics/Rendering/Chart/Axis/Floating.hs @@ -18,6 +18,7 @@ LogAxisParams(..), defaultLinearAxis, defaultLogAxis, + scaledAxis, autoScaledAxis, autoScaledLogAxis, autoSteps, @@ -91,14 +92,12 @@ la_nTicks_ = 50 } --- | Generate a linear axis automatically, scaled appropriately for the --- input data. -autoScaledAxis :: RealFloat a => LinearAxisParams a -> AxisFn a -autoScaledAxis lap ps0 = makeAxis' realToFrac realToFrac - (la_labelf_ lap) (labelvs,tickvs,gridvs) +-- | 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 - (min,max) = (minimum ps,maximum ps) range [] = (0,1) range _ | min == max = if min==0 then (-1,1) else let d = abs (min * 0.01) in (min-d,max+d) @@ -108,6 +107,13 @@ (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'] diff --git a/Graphics/Rendering/Chart/Axis/Int.hs b/Graphics/Rendering/Chart/Axis/Int.hs --- a/Graphics/Rendering/Chart/Axis/Int.hs +++ b/Graphics/Rendering/Chart/Axis/Int.hs @@ -11,6 +11,7 @@ module Graphics.Rendering.Chart.Axis.Int( defaultIntAxis, + scaledIntAxis, autoScaledIntAxis ) where @@ -38,10 +39,15 @@ autoScaledIntAxis :: (Integral i, PlotValue i) => LinearAxisParams i -> AxisFn i -autoScaledIntAxis lap ps = - makeAxis (la_labelf_ lap) (labelvs,tickvs,gridvs) +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) diff --git a/Graphics/Rendering/Chart/Layout.hs b/Graphics/Rendering/Chart/Layout.hs --- a/Graphics/Rendering/Chart/Layout.hs +++ b/Graphics/Rendering/Chart/Layout.hs @@ -342,15 +342,20 @@ in plot_render_ p pmfn rPlot1 _ _ _ = return () - pickfn (Point x y) = case (lAxis,rAxis) of - (Just at,Nothing) -> Just $ L1P_PlotArea xv (mapy at y) (mapy at y) - (Nothing,Just at) -> Just $ L1P_PlotArea xv (mapy at y) (mapy at y) - (Just at1,Just at2) -> Just $ L1P_PlotArea xv (mapy at1 y) (mapy at2 y) - (Nothing,Nothing) -> Nothing + 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 - xv = case (bAxis,tAxis) of - (Just at,_) -> mapx at x - (_,Just at) -> mapx at x + 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 diff --git a/Graphics/Rendering/Chart/Plot/AreaSpots.hs b/Graphics/Rendering/Chart/Plot/AreaSpots.hs --- a/Graphics/Rendering/Chart/Plot/AreaSpots.hs +++ b/Graphics/Rendering/Chart/Plot/AreaSpots.hs @@ -59,7 +59,8 @@ { area_spots_title_ :: String , area_spots_linethick_ :: Double , area_spots_linecolour_ :: AlphaColour Double - , area_spots_fillcolour_ :: 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)] } @@ -69,7 +70,8 @@ { area_spots_title_ = "" , area_spots_linethick_ = 0.1 , area_spots_linecolour_ = opaque blue - , area_spots_fillcolour_ = flip withOpacity 0.2 blue + , area_spots_fillcolour_ = blue + , area_spots_opacity_ = 0.2 , area_spots_max_radius_ = 20 -- in pixels , area_spots_values_ = [] } @@ -88,8 +90,10 @@ (area_spots_values_ p)) (\ (x,y,z)-> do let radius = sqrt z - let (CairoPointStyle drawSpotAt) = filledCircles radius - (area_spots_fillcolour_ p) + 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) @@ -106,8 +110,10 @@ 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 - (area_spots_fillcolour_ p) + 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) @@ -126,6 +132,7 @@ { 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)] } @@ -135,6 +142,7 @@ { 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_ = [] } @@ -157,7 +165,8 @@ let radius = sqrt z let colour = (area_spots_4d_palette_ p) !! t let (CairoPointStyle drawSpotAt) - = filledCircles radius (flip withOpacity 0.2 colour) + = 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) @@ -183,9 +192,10 @@ 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 0.2 $ - head (area_spots_4d_palette_ p)) + 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) diff --git a/Graphics/Rendering/Chart/SparkLine.hs b/Graphics/Rendering/Chart/SparkLine.hs new file mode 100644 --- /dev/null +++ b/Graphics/Rendering/Chart/SparkLine.hs @@ -0,0 +1,169 @@ +--------------------------------------------------------------- +-- | +-- 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 diff --git a/Graphics/Rendering/Chart/Types.hs b/Graphics/Rendering/Chart/Types.hs --- a/Graphics/Rendering/Chart/Types.hs +++ b/Graphics/Rendering/Chart/Types.hs @@ -316,9 +316,7 @@ c $ setSourceColor (line_color_ ls) c $ C.setLineCap (line_cap_ ls) c $ C.setLineJoin (line_join_ ls) - case line_dashes_ ls of - [] -> return () - ds -> c $ C.setDash ds 0 + c $ C.setDash (line_dashes_ ls) 0 setFillStyle :: CairoFillStyle -> CRender () setFillStyle (CairoFillStyle s) = s diff --git a/tests/all_tests.hs b/tests/all_tests.hs --- a/tests/all_tests.hs +++ b/tests/all_tests.hs @@ -30,6 +30,7 @@ import qualified Test15 import qualified Test17 import qualified TestParametric +import qualified TestSparkLines data OutputType = PNG | PS | PDF | SVG @@ -327,58 +328,61 @@ } ---------------------------------------------------------------------- -allTests :: [ (String, OutputType -> Renderable ()) ] +stdSize = (640,480) + +allTests :: [ (String, (Int,Int), OutputType -> Renderable ()) ] allTests = - [ ("test1", \o -> Test1.chart (chooseLineWidth o) ) - , ("test1a", \o -> test1a (chooseLineWidth o) ) - , ("test2a", \o -> Test2.chart prices False (chooseLineWidth o)) - , ("test2b", \o -> Test2.chart prices1 False (chooseLineWidth o)) - , ("test2c", \o -> Test2.chart prices2 False (chooseLineWidth o)) - , ("test2d", \o -> Test2.chart prices5 True (chooseLineWidth o)) - , ("test2e", \o -> Test2.chart prices6 True (chooseLineWidth o)) - , ("test2f", \o -> Test2.chart prices7 True (chooseLineWidth o)) - , ("test2g", \o -> Test2.chart prices3 False (chooseLineWidth o)) - , ("test2h", \o -> Test2.chart prices8 True (chooseLineWidth o)) - , ("test2i", \o -> Test2.chart prices9 True (chooseLineWidth o)) - , ("test2j", \o -> Test2.chart prices10 True (chooseLineWidth o)) - , ("test2k", \o -> Test2.chart prices10a True (chooseLineWidth o)) - , ("test2m", \o -> Test2.chart prices11 True (chooseLineWidth o)) - , ("test2n", \o -> Test2.chart prices10b True (chooseLineWidth o)) - , ("test2o", \o -> Test2.chart prices12 True (chooseLineWidth o)) - , ("test2p", \o -> Test2.chart prices13 True (chooseLineWidth o)) - , ("test2q", \o -> Test2.chart prices13a True (chooseLineWidth o)) - , ("test2r", \o -> Test2.chart prices13b True (chooseLineWidth o)) - , ("test2s", \o -> Test2.chart prices14 True (chooseLineWidth o)) - , ("test2t", \o -> Test2.chart prices14a True (chooseLineWidth o)) - , ("test2u", \o -> Test2.chart prices14b True (chooseLineWidth o)) - , ("test2v", \o -> Test2.chart prices14c True (chooseLineWidth o)) - , ("test2w", \o -> Test2.chart prices14d True (chooseLineWidth o)) - , ("test3", const Test3.chart) - , ("test4a", const (Test4.chart False False)) - , ("test4b", const (Test4.chart True False)) - , ("test4c", const (Test4.chart False True)) - , ("test4d", test4d) - , ("test5", \o -> Test5.chart (chooseLineWidth o)) - , ("test6", const Test6.chart) - , ("test7", const Test7.chart) - , ("test8", const Test8.chart) - , ("test9", const (Test9.chart True)) - , ("test9b", const (Test9.chart False)) - , ("test9c", test9 BarsCentered) - , ("test9l", test9 BarsLeft) - , ("test9r", test9 BarsRight) - , ("test10", test10 prices1) - , ("test11", test11) - , ("test12", test12) - , ("test13", test13) - , ("test14", \o -> Test14.chart (chooseLineWidth o) ) - , ("test14a", \o -> Test14a.chart (chooseLineWidth o) ) - , ("test15a", const (Test15.chart (LORows 2))) - , ("test15b", const (Test15.chart (LOCols 2))) - , ("test17", \o -> Test17.chart (chooseLineWidth o)) - , ("misc1", setPickFn nullPickFn . misc1 0) - , ("misc1a", setPickFn nullPickFn . misc1 45) - , ("parametric", \o -> TestParametric.chart (chooseLineWidth o) ) + [ ("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 @@ -392,20 +396,20 @@ main1 ("--png":tests) = showTests tests renderToPNG main1 tests = showTests tests renderToPNG -showTests :: [String] -> ((String,OutputType -> Renderable ()) -> IO()) -> IO () +showTests :: [String] -> ((String,(Int,Int),OutputType -> Renderable ()) -> IO()) -> IO () showTests tests ofn = mapM_ doTest (filter (match tests) allTests) where - doTest (s,f) = do + doTest (s,size,f) = do putStrLn (s ++ "... ") - ofn (s,f) + ofn (s,size,f) -match :: [String] -> (String,a) -> Bool +match :: [String] -> (String,s,a) -> Bool match [] t = True -match ts t = (fst t) `elem` ts +match ts (s,_,_) = s `elem` ts -renderToPNG (n,ir) = renderableToPNGFile (ir PNG) 640 480 (n ++ ".png") - >> return () -renderToPS (n,ir) = renderableToPSFile (ir PS) 640 480 (n ++ ".ps") -renderToPDF (n,ir) = renderableToPDFFile (ir PDF) 640 480 (n ++ ".pdf") -renderToSVG (n,ir) = renderableToSVGFile (ir SVG) 640 480 (n ++ ".svg") +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")