Chart-tests (empty) → 1.9.3

raw patch · 32 files changed

+2571/−0 lines, 32 filesdep +Chartdep +Chart-cairodep +Chart-diagramssetup-changed

Dependencies added: Chart, Chart-cairo, Chart-diagrams, Chart-gtk, array, base, bytestring, cairo, colour, containers, data-default-class, diagrams-cairo, diagrams-core, diagrams-lib, diagrams-postscript, diagrams-svg, doctest, gtk, lens, mtl, old-locale, old-time, random, svg-builder, time

Files

• Chart-tests.cabal +85/−0
• LICENSE +31/−0
• Setup.hs +8/−0
• tests/CompareFonts.hs +98/−0
• tests/DiagramsCairo.hs +30/−0
• tests/DiagramsEPS.hs +32/−0
• tests/DiagramsSVG.hs +36/−0
• tests/Doctests.hs +12/−0
• tests/Drawing/Cairo.hs +15/−0
• tests/Drawing/DiagramsCairo.hs +26/−0
• tests/Drawing/Tests.hs +280/−0
• tests/ExampleStocks.hs +219/−0
• tests/GtkTestPicking.hs +117/−0
• tests/Main.hs +70/−0
• tests/Prices.hs +392/−0
• tests/Test1.hs +38/−0
• tests/Test14.hs +45/−0
• tests/Test14a.hs +47/−0
• tests/Test15.hs +43/−0
• tests/Test17.hs +79/−0
• tests/Test19.hs +28/−0
• tests/Test2.hs +63/−0
• tests/Test3.hs +36/−0
• tests/Test4.hs +35/−0
• tests/Test5.hs +46/−0
• tests/Test7.hs +32/−0
• tests/Test8.hs +23/−0
• tests/Test9.hs +38/−0
• tests/TestParametric.hs +27/−0
• tests/TestSparkLines.hs +30/−0
• tests/Tests.hs +498/−0
• tests/Utils.hs +12/−0

@@ -0,0 +1,85 @@+Name: Chart-tests+Version: 1.9.3+License: BSD3+License-file: LICENSE+Copyright: Tim Docker, 2006-2014+Author: Tim Docker <tim@dockerz.net>+Maintainer: Tim Docker <tim@dockerz.net>+Homepage: https://github.com/timbod7/haskell-chart/wiki+Synopsis: Tests of the Charts library.+Description: Tests of the Charts library.+Category: Graphics+Cabal-Version: >= 1.10+Build-Type: Simple+++source-repository head+  type:     git+  location: https://github.com/timbod7/haskell-chart++Executable chart-harness+  Build-Depends:+    base >= 3 && < 5,+    old-locale,+    array,+    time,+    mtl,+    colour          >= 2.2.1 && < 2.4,+    lens            >= 3.9 && < 4.19,+    data-default-class < 0.2,+    bytestring      >= 0.9 && < 1.0,+    svg-builder     >= 0.1 && < 0.2,+    random          >= 1.0,+    containers      >= 0.4 && <0.7,+    old-time        >= 1.0,+    Chart           >= 1.9 && < 1.10,+    Chart-cairo     >= 1.9 && < 1.10,+    Chart-gtk       >= 1.9 && < 1.10,+    Chart-diagrams  >= 1.9 && < 1.10,+    gtk             >= 0.9.11,+    cairo           >= 0.9.11,+    diagrams-cairo  >= 1.3 && < 1.5,+    diagrams-svg    >= 1.4 && < 1.5,+    diagrams-postscript    >= 0.7 && < 1.6,+    diagrams-lib    >= 1.2 && < 1.5,+    diagrams-core   >= 1.3 && < 1.5+  Main-is: Main.hs+  Hs-Source-Dirs: tests+  Ghc-Options: -threaded+  default-language:    Haskell2010+  other-modules:+    CompareFonts+    DiagramsCairo+    DiagramsEPS+    DiagramsSVG+    Drawing.Cairo+    Drawing.DiagramsCairo+    Drawing.Tests+    ExampleStocks+    GtkTestPicking+    Prices+    Test1+    Test2+    Test3+    Test4+    Test5+    Test7+    Test8+    Test9+    Test14a+    Test14+    Test15+    Test17+    Test19+    TestParametric+    Tests+    TestSparkLines+    Utils++test-suite doctests+  type:                exitcode-stdio-1.0+  main-is:             Doctests.hs+  build-depends:       base >= 4.7 && < 5+                     , doctest >= 0.8+  default-language:    Haskell2010+  Hs-Source-Dirs:      tests

@@ -0,0 +1,31 @@+Copyright (c) 2006, Tim Docker++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission. ++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,8 @@+#!/usr/bin/env runghc++module Main where++import Distribution.Simple++main :: IO ()+main = defaultMain

@@ -0,0 +1,98 @@+module CompareFonts where++import Data.Colour+import Data.Colour.Names+import Data.Monoid+import Data.Default.Class++import Graphics.Rendering.Chart.Backend+import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing+import qualified Graphics.Rendering.Chart.Backend.Diagrams as BD+import qualified Graphics.Rendering.Chart.Backend.Cairo as BC++import Diagrams.Core ( renderDia )+import Diagrams.Prelude ( dims, V2(..) )+import Diagrams.Backend.Cairo hiding ( renderCairo )+import Diagrams.Backend.Cairo.Internal++import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.Matrix as CM++markLineStyle :: LineStyle+markLineStyle = def+  { _line_color = opaque red+  , _line_width = 1+  }++-- Render a few lines and mark them appropriatly.+main :: IO ()+main = render ("test.png") 1000 500 $ do+  withTranslation (Point 10 10) $ do+    (flip mapM_) [0 .. 5] $ \i -> do+      let d = fromIntegral i+      withTranslation (Point 0 (d * 70)) $ testDrawText (i * 10 + 10)+    return ()++testDrawText :: Int -> BackendProgram ()+testDrawText fontSize =+  withFontStyle (def { _font_size = fromIntegral fontSize, _font_name = "Source Sans Pro" }) $ do+    let text = "ÄÖÜ Testing " ++ show fontSize ++ "px"+    -- Text metrics+    ts <- textSize text+    let a = textSizeAscent ts+        d = textSizeDescent ts+    -- Baseline and descent line: Red+    withLineStyle markLineStyle $ do+      p <- alignStrokePath $ moveTo' 0 a+                          <> lineTo' 500 a+                          <> moveTo' 0 (a + d)+                          <> lineTo' 500 (a + d)+      strokePath p+    -- Bounding lines: Green+    withLineStyle (markLineStyle { _line_color = opaque green }) $ do+      p <- alignStrokePath $ moveTo' 0 0+                          <> lineTo' 500 0+                          <> moveTo' 0 (fromIntegral fontSize)+                          <> lineTo' 500 (fromIntegral fontSize)+                          <> moveTo' 0 0+                          <> lineTo' 0 (fromIntegral fontSize)++      strokePath p+    drawText (Point 0 a) text++-- Render it side by side using cairo and diagrams cairo with SVGFonts.+render :: FilePath -> Int -> Int -> BackendProgram () -> IO ()+render f w h m = do+  rc <- renderCairo (w,h) m+  rd <- renderDiagramsCairo (w,h) m+  s <- C.createImageSurface C.FormatARGB32 w h+  C.renderWith s $ do+    C.setSourceRGB 1 1 1+    C.paint+    C.setSourceRGB 0 0 0+    C.newPath+    C.moveTo (fromIntegral w / 2) 0+    C.lineTo (fromIntegral w / 2) (fromIntegral h)+    C.stroke+  C.renderWith s $ do+    C.rectangle 0 0 500 500+    C.clip+    rc+  C.renderWith s $ do+    C.setMatrix (CM.translate (fromIntegral w/2) 0 CM.identity)+    C.rectangle 0 0 500 500+    C.clip+    C.scale 1 (-1)+    rd+  C.surfaceWriteToPNG s f++renderCairo :: (Int, Int) -> BackendProgram () -> IO (C.Render ())+renderCairo (w,h) m = do+  return $ BC.runBackend (BC.defaultEnv bitmapAlignmentFns) m++renderDiagramsCairo :: (Int, Int) -> BackendProgram () -> IO (C.Render ())+renderDiagramsCairo (w,h) m = do+  env <- BD.defaultEnv bitmapAlignmentFns (fromIntegral w) (fromIntegral h)+  let (d, _) = BD.runBackend env m+  return $ snd $ renderDia Cairo (CairoOptions "" (dims $ V2 (fromIntegral w) (fromIntegral h)) PNG True) d

@@ -0,0 +1,30 @@+module DiagramsCairo where++import Graphics.Rendering.Chart.Backend+import Graphics.Rendering.Chart.Backend.Diagrams++import Diagrams.Core ( renderDia )+import Diagrams.Prelude ( dims, V2(..) )+import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.Internal+import Graphics.Rendering.Chart.Renderable ( render, Renderable )++import System.Environment ( getArgs )++import Tests ( allTests, showTests )+import qualified Tests as T++main = do+    args <- getArgs+    main1 args++main1 :: [String] -> IO ()+main1 args = do+  -- Only load the environment once, to speed things up.+  env <- defaultEnv bitmapAlignmentFns 500 500+  let renderDiagram :: (String, (Int, Int), T.LineWidth -> Renderable ()) -> IO ()+      renderDiagram (n,(w,h),ir) = do+        let env' = env { envOutputSize = (fromIntegral w, fromIntegral h) }+            (d, _) = runBackendR env' (ir 1.0)+        fst $ renderDia Cairo (CairoOptions (n ++ ".png") (dims $ V2 (fromIntegral w) (fromIntegral h)) PNG False) d+  showTests (fmap (\(x,_,_) -> x) allTests) renderDiagram

@@ -0,0 +1,32 @@+module DiagramsEPS where++import Graphics.Rendering.Chart.Backend+import Graphics.Rendering.Chart.Backend.Diagrams++import Diagrams.Core ( renderDia )+import Graphics.Rendering.Chart.Renderable ( render, Renderable )+import qualified Diagrams.Backend.Postscript as DEPS++import System.Environment ( getArgs )++import Tests ( allTests, showTests )+import qualified Tests as T++main = do+    args <- getArgs+    main1 args++main1 :: [String] -> IO ()+main1 args = do+    -- We don't use the renderableToFile function as we want to construct the+    -- environment once for speed+    env0 <- defaultEnv bitmapAlignmentFns 0 0+    showTests (fmap (\(x,_,_) -> x) allTests) (renderDiagram env0)+  where+    renderDiagram :: DEnv Double -> (String, (Int, Int), T.LineWidth -> Renderable ()) -> IO ()+    renderDiagram env0 (n,(w,h),ir) = do+      let cr = render (ir 0.25) (fromIntegral w, fromIntegral h)+          path = n ++ ".eps"+          fo = FileOptions (fromIntegral w, fromIntegral h) EPS loadSansSerifFonts+      cBackendToFile fo cr path+      putStrLn (path ++ "...")

@@ -0,0 +1,36 @@+module DiagramsSVG where++import Control.Monad (void)+import Graphics.Rendering.Chart.Backend+import Graphics.Rendering.Chart.Backend.Diagrams++import qualified Data.ByteString.Lazy as BS++import Diagrams.Core ( renderDia )+import Diagrams.Backend.SVG+import Graphics.Rendering.Chart.Renderable ( render, Renderable )+import qualified Graphics.Svg as Svg++import System.Environment ( getArgs )++import Tests ( allTests, showTests )+import qualified Tests as T++main = do+    args <- getArgs+    main1 args++main1 :: [String] -> IO ()+main1 args = do+    -- We don't use the renderableToFile function as we want to construct the+    -- environment once for speed+    env0 <- defaultEnv bitmapAlignmentFns 0 0+    showTests (fmap (\(x,_,_) -> x) allTests) (renderDiagram env0)+  where+    renderDiagram :: DEnv Double -> (String, (Int, Int), T.LineWidth -> Renderable ()) -> IO ()+    renderDiagram env0 (n,(w,h),ir) = do+      let cr = render (ir 0.25) (fromIntegral w, fromIntegral h)+          path = n ++ ".svg"+          fo = FileOptions (fromIntegral w, fromIntegral h) Graphics.Rendering.Chart.Backend.Diagrams.SVG loadSansSerifFonts+      putStrLn (path ++ "...")+      void $ cBackendToFile fo cr path

@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -Wall #-}++module Main ( main ) where++import Test.DocTest++main :: IO ()+main =+  doctest+    [ "../chart/Graphics/Rendering/Chart/Axis/Floating.hs"+    , "../chart/Numeric/Histogram.hs"+    ]

@@ -0,0 +1,15 @@+module Drawing.Cairo where++import Control.Monad++import Graphics.Rendering.Chart.Backend+import Graphics.Rendering.Chart.Backend.Cairo++import Drawing.Tests++main :: IO ()+main = (flip mapM_) tests $ \(name, w, h, draw) -> do+  render (name ++ ".png") w h draw++render :: FilePath -> Int -> Int -> BackendProgram a -> IO ()+render f w h m = void $ cBackendToFile (FileOptions (w,h) PNG) m f

@@ -0,0 +1,26 @@+module Drawing.DiagramsCairo where++import Control.Monad(forM_)++import Graphics.Rendering.Chart.Backend+import Graphics.Rendering.Chart.Backend.Diagrams++import Diagrams.Core ( renderDia )+import Diagrams.Prelude ( dims, V2(..) )+import Diagrams.Backend.Cairo+import Diagrams.Backend.Cairo.Internal++import Drawing.Tests (tests)++main :: IO ()+main = do+  fonts <- loadCommonFonts+  forM_ tests $ \(name, w, h, draw) -> do+    render fonts (name ++ ".png") w h draw+++render :: FontSelector Double -> FilePath -> Int -> Int -> BackendProgram a -> IO ()+render fonts f w h m = do+  let env = createEnv bitmapAlignmentFns (fromIntegral w) (fromIntegral h) fonts+  let (d, _) = runBackend env m+  fst $ renderDia Cairo (CairoOptions f (dims $ V2 (fromIntegral w) (fromIntegral h)) PNG False) d

@@ -0,0 +1,280 @@++module Drawing.Tests where++import Data.Monoid+import Data.Default.Class+import Data.Colour+import Data.Colour.Names+import Data.List++import Graphics.Rendering.Chart.Geometry+import Graphics.Rendering.Chart.Drawing+import Graphics.Rendering.Chart.Backend++supportLineStyle :: LineStyle+supportLineStyle = def+  { _line_color = withOpacity red 0.15+  , _line_width = 2+  , _line_dashes = []+  , _line_cap = LineCapButt+  , _line_join = LineJoinBevel+  }++withTestEnv :: BackendProgram a -> BackendProgram a+withTestEnv m = do+  let p = rectPath $ Rect (Point 0 0) (Point 500 500)+  withFillStyle (solidFillStyle $ opaque white) $ fillPath p >> m++withCenterRot :: Double -> Int -> Int -> BackendProgram a -> BackendProgram a+withCenterRot a x y m =+  withTranslation (Point (fromIntegral x)+                         (fromIntegral y)) $ withRotation a $ m++tests :: [(String, Int, Int, BackendProgram ())]+tests = [ ("lines", 500, 500, testLines)+        , ("arcs" , 500, 500, testArcs)+        , ("text" , 500, 500, testText)+        , ("fill" , 500, 500, testFill)+        , ("clip" , 500, 500, testClip)+        , ("paths" , 500, 500, testPaths)+        , ("text-metrics" , 500, 500, testTextMetrics)+        ] ++ ( (flip map) testEnvironments+               $ \(name, env) -> ("environment-" ++ name, 500, 500, env)+             )++testPaths :: BackendProgram ()+testPaths = withTestEnv+          $ withLineStyle (def { _line_width = 10, _line_join = LineJoinMiter })+          $ withFillStyle (solidFillStyle $ opaque red)+          $ do+  let distantArc = moveTo' 10 10+                <> lineTo' 10 50+                <> arcNeg' 50 30 20 (pi / 2) (-(pi / 2))+  strokePath $ distantArc+  withTranslation (Point  90 0) $ strokePath $ distantArc <> close+  withTranslation (Point 180 0) $ fillPath   $ distantArc++  let multiArc = arcNeg' 30 150 20 pi 0+              <> arc' 90 150 40 pi (2*pi)+              <> arcNeg' 190 150 60 pi (0)+  strokePath $ multiArc+  withTranslation (Point 0 100) $ strokePath $ multiArc <> close+  withTranslation (Point 0 200) $ fillPath $ multiArc <> close++  let multiDistArc = arc' 380 150 60 pi (2*pi)+                  <> arc' 350 130 60 0 pi+  strokePath $ multiDistArc+  withTranslation (Point 0 140) $ strokePath $ multiDistArc <> close+  withTranslation (Point 0 280) $ fillPath $ multiDistArc <> close++testTextMetrics :: BackendProgram ()+testTextMetrics = withTestEnv $ do++  withFontStyle (def { _font_size = 20 }) $ do+    let text = "Text Example"+    tm <- textSize text+    drawText (Point 100 125) text+    -- Support Lines+    withLineStyle supportLineStyle $ do+      -- Baseline+      strokePath $ moveTo' 0 125 <> lineTo' 500 125+      -- Above the text+      strokePath $ moveTo' 0 (125 - textSizeAscent tm) <> lineTo' 500 (125 - textSizeAscent tm)+      -- Beneath the text+      strokePath $ moveTo' 0 (125 + textSizeDescent tm) <> lineTo' 500 (125 + textSizeDescent tm)+      -- Right side of text+      strokePath $ moveTo' (100 + textSizeWidth tm) 0 <> lineTo' (100 + textSizeWidth tm) 250+      -- Left side of text+      strokePath $ moveTo' 100 0 <> lineTo' 100 250++  withFontStyle (def { _font_size = 15 }) $ do+    (flip mapM_) [ (VTA_Top, "Top", 10)+                 , (VTA_Centre, "Centre", 50)+                 , (VTA_BaseLine, "BaseLine", 110)+                 , (VTA_Bottom, "Bottom", 190) ] $ \(vta, name, offset) -> do+      drawTextA HTA_Left vta (Point offset 375) name++  withFontStyle (def { _font_size = 15 }) $ do+    (flip mapM_) [ (HTA_Left, "Left", 10)+                 , (HTA_Centre, "Centre", 40)+                 , (HTA_Right, "Right", 70) ] $ \(hta, name, offset) -> do+      drawTextA hta VTA_Top (Point 375 $ 250 + offset) name++  withLineStyle supportLineStyle $ do+    strokePath $ moveTo' 0 375 <> lineTo' 250 375+    strokePath $ moveTo' 375 250 <> lineTo' 375 500+++testClip :: BackendProgram ()+testClip = withTestEnv $ do+  let p = rectPath $ Rect (Point 0 0) (Point 500 500)+  withFillStyle (solidFillStyle $ opaque blue) $ fillPath p+  withClipRegion (Rect (Point 100 100) (Point 300 300)) $ do+    withFillStyle (solidFillStyle $ opaque green) $ fillPath p+    withClipRegion (Rect (Point 200 200) (Point 400 400)) $ do+      withFillStyle (solidFillStyle $ withOpacity red 0.5) $ fillPath p+  withClipRegion (Rect (Point 150 50) (Point 400 150)) $ do+    withFillStyle (solidFillStyle $ opaque red) $ fillPath p++testFill :: BackendProgram ()+testFill = withTestEnv $ do+  withFillStyle (solidFillStyle $ opaque green) $ do+    fillPath $ arc' 100 100 75 0 (1.5 * pi)+  withFillStyle (solidFillStyle $ opaque blue) $ do+    fillPath $ moveTo' 475 475+            <> lineTo' 325 475+            <> lineTo' 325 325+            <> close+    withFillStyle (solidFillStyle $ withOpacity teal 0.6) $ do+      fillPath $ moveTo' 125 125+              <> lineTo' 400 125+              <> lineTo' 400 400+              <> lineTo' 125 400+              <> moveTo' 450 450+              <> lineTo' 500 450+              <> lineTo' 500 500+              <> lineTo' 450 500+    fillPath $ arcNeg' 125 400 75 0 (1.5 * pi)+            <> lineTo' 125 400++testEnvironments :: [(String, BackendProgram ())]+testEnvironments =+  let envs = [ ("fill", withFillStyle $ solidFillStyle $ opaque green)+             , ("font", withFontStyle $ def { _font_color = opaque red })+             , ("line", withLineStyle $ def { _line_color = opaque blue, _line_width = 10 })+             ]+  in (flip map) (permutations envs) $ \envPerm ->+    let name = concatMap fst envPerm+    in ( name+       , withTestEnv $ foldr1 (.) (map snd envPerm) $ do+            strokePath $ moveTo' 475 10+                      <> lineTo' 475 250+            fillPath $ arc' 450 450 40 0 (2*pi)+            drawText (Point 10 30) name+            drawText (Point 10 50) "Green Fill, Red Font, Blue Line"+       )+++testText :: BackendProgram ()+testText = withTestEnv $ do+  drawText (Point 10 50) "No Scale"+  withTranslation (Point 10 70) $ do+    withScale (Vector 2 1) $ drawText (Point 0 0) "Horz. Scale"+  withTranslation (Point 10 100) $ do+    withScale (Vector 1 3) $ drawText (Point 0 0) "Vert. Scale"++  drawText (Point 150 50) "Size * 1"+  withFontStyle (def { _font_size = _font_size def * 2 }) $ drawText (Point 150 70) "Size * 2"+  withFontStyle (def { _font_size = _font_size def * 3 }) $ drawText (Point 150 100) "Size * 3"++  (flip mapM_) ([ 10, 12, 14 ] `zip` [0..]) $ \(size, n) -> do+    withFontStyle (def { _font_weight = FontWeightNormal, _font_size = size }) $+      drawText (Point 10 $ 120 + n * 20) "Normal Weight"+    withFontStyle (def { _font_weight = FontWeightBold, _font_size = size   }) $+      drawText (Point 150 $ 120 + n * 20) "Bold Weight"++    withFontStyle (def { _font_slant = FontSlantNormal, _font_size = size }) $+      drawText (Point 10 $ 180 + n * 20) "Normal Slant"+    withFontStyle (def { _font_slant = FontSlantItalic, _font_size = size }) $+      drawText (Point 150 $ 180 + n * 20) "Italic Slant"+    withFontStyle (def { _font_slant = FontSlantOblique, _font_size = size }) $+      drawText (Point 290 $ 180 + n * 20) "Oblique Slant"+++  (flip mapM_) ([ 10, 12, 14 ] `zip` [0..]) $ \(size, n) -> do+    withFontStyle (def { _font_name = "sans-serif", _font_size = size }) $+      drawText (Point 10 $ 240 + n * 20) "Sans-Serif"+    withFontStyle (def { _font_name = "serif", _font_size = size }) $+      drawText (Point 150 $ 240 + n * 20) "Serif"+    withFontStyle (def { _font_name = "monospace", _font_size = size }) $+      drawText (Point 290 $ 240 + n * 20) "Monospace"++  (flip mapM_) ([ (opaque red, 12)+                , (withOpacity blue 0.3, 14)+                , (opaque green, 17) ] `zip` [0..] ) $ \((cl, size), n) -> do+    withFontStyle (def { _font_color = cl, _font_size = size }) $+      drawText (Point (10 + (n * 140)) 300) "Colored"++  (flip mapM_) [0..7] $ \n -> do+    withTranslation (Point 250 400) $+      withRotation (n * 0.125 * 2 * pi) $+        drawText (Point 30 0) $ show n+  -- Support Lines+  withLineStyle supportLineStyle $ do+    strokePath $ moveTo' 0 400 <> lineTo' 500 400+    strokePath $ moveTo' 250 300 <> lineTo' 250 500++testArcs :: BackendProgram ()+testArcs = withTestEnv $ do+  (flip mapM_) ( [ def { _line_cap = LineCapButt  , _line_join = LineJoinMiter, _line_width = 10 }+                 , def { _line_cap = LineCapRound , _line_join = LineJoinRound, _line_width = 10 }+                 , def { _line_cap = LineCapSquare, _line_join = LineJoinBevel, _line_width = 10 }+                 , def { _line_width = 10 }+                 ] `zip` [0..] )+                 $ \(ls, n) -> do+    withLineStyle ls $ do+      strokePath $ arc' 250 250 (20 * (n + 1)) (n * 0.5 * pi) ((n+1) * 0.5 * pi)+      strokePath $ arc' 250 250 (125 + 30 * (n + 1))+                                (n * 0.5 * pi + 0.25 * pi)+                                ((n+1) * 0.5 * pi + 0.25 * pi)+                <> close+  -- Support Lines+  withLineStyle supportLineStyle $ do+    strokePath $ moveTo' 250 0 <> lineTo' 250 500+    strokePath $ moveTo' 0 250 <> lineTo' 500 250+    strokePath $ moveTo' 0 0 <> lineTo' 500 500+    strokePath $ moveTo' 500 0 <> lineTo' 0 500+    withCenterRot (0.0 * pi) 250 250 $ drawText (Point 100 0) $ "0"+    withCenterRot (0.5 * pi) 250 250 $ drawText (Point  50 0) $ "1/2 * pi"+    withCenterRot (1.0 * pi) 250 250 $ drawText (Point  75 0) $ "1 * pi"+    withCenterRot (1.5 * pi) 250 250 $ drawText (Point 100 0) $ "3/2 * pi"++testLines :: BackendProgram ()+testLines = withTestEnv $ do+  -- Test Line Caps+  (flip mapM_) [ (def { _line_cap = LineCapButt  , _line_width = 10 }, 0)+               , (def { _line_cap = LineCapRound , _line_width = 10 }, 20)+               , (def { _line_cap = LineCapSquare, _line_width = 10 }, 40)+               ] $ \(ls, offset) -> do+    withLineStyle ls $ do+      strokePath $ moveTo' 125 (10 + offset)+                <> lineTo' 375 (10 + offset)+  -- Test Line Joins+  (flip mapM_) [ (def { _line_join = LineJoinMiter, _line_width = 10 }, 0)+               , (def { _line_join = LineJoinRound, _line_width = 10 }, 60)+               , (def { _line_join = LineJoinBevel, _line_width = 10 }, 120)+               ] $ \(ls, offset) -> do+    withLineStyle ls $ do+      strokePath $ moveTo' 125 (70  + offset)+                <> lineTo' 375 (70  + offset)+                <> lineTo' 250 (110 + offset)+                <> close+  -- Test Line Color & Width+  (flip mapM_) [ (def { _line_color = opaque blue, _line_width = 1 }, 0)+               , (def { _line_color = opaque green, _line_width = 5 }, 10)+               , (def { _line_color = opaque magenta, _line_width = 20 }, 35)+               , (def { _line_color = withOpacity cyan 0.2, _line_width = 10 }, 60)+               , (def { _line_color = withOpacity cyan 0.4, _line_width = 10 }, 80)+               , (def { _line_color = withOpacity cyan 0.6, _line_width = 10 }, 100)+               , (def { _line_color = withOpacity cyan 0.8, _line_width = 10 }, 120)+               , (def { _line_color = withOpacity cyan 1.0, _line_width = 10 }, 140)+               ] $ \(ls, offset) -> do+    withLineStyle ls $ do+      strokePath $ moveTo' 10  (250 + offset)+                <> lineTo' 490 (250 + offset)+  -- Test Line Dashes+  (flip mapM_) [ (def { _line_dashes = []  , _line_width = 10 }, 0)+               , (def { _line_dashes = [10] , _line_width = 10 }, 20)+               , (def { _line_dashes = [1,5,2], _line_width = 10 }, 40)+               , (def { _line_dashes = [1,5,2,3,4,6,7], _line_width = 10 }, 60)+               ] $ \(ls, offset) -> do+    withLineStyle ls $ do+      strokePath $ moveTo' 10  (410 + offset)+                <> lineTo' 490 (410 + offset)+  -- Support Lines+  withLineStyle supportLineStyle $ do+    strokePath $ moveTo' 10  0 <> lineTo' 10  500+    strokePath $ moveTo' 250 0 <> lineTo' 250 500+    strokePath $ moveTo' 490 0 <> lineTo' 490 500+    strokePath $ moveTo' 375 0 <> lineTo' 375 500+    strokePath $ moveTo' 125 0 <> lineTo' 125 500

@@ -0,0 +1,219 @@+module 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))+    ]++

@@ -0,0 +1,117 @@+module GtkTestPicking where++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Layout(layoutLRToRenderable)+import Graphics.Rendering.Chart.Grid+import Graphics.Rendering.Chart.Backend.Cairo+import qualified Graphics.UI.Gtk as G+import qualified Graphics.UI.Gtk.Gdk.Events as GE+import qualified Graphics.Rendering.Cairo as C++import Data.Time.LocalTime+import Data.Colour+import Data.Colour.Names+import Data.Colour.SRGB+import Data.Default.Class+import Control.Lens+import Data.IORef+import System.Environment(getArgs)+import Prices(prices2)++type PickType = LayoutPick LocalTime Double Double++chart :: [(LocalTime,Double,Double)]+      -> Bool -> Double -> Renderable (LayoutPick LocalTime Double Double)+chart prices showMinMax lwidth = layoutLRToRenderable layout+  where++    lineStyle c = line_width .~ 3 * lwidth+                $ line_color .~ c+                $ def ^. plot_lines_style++    limitLineStyle c = line_width .~ lwidth+                $ line_color .~ opaque c+                $ line_dashes .~ [5,10]+                $ def ^. plot_lines_style++    price1 = plot_lines_style .~ lineStyle (opaque blue)+           $ plot_lines_values .~ [[ (d, v) | (d,v,_) <- prices]]+           $ plot_lines_title .~ "price 1"+           $ def++    price2 = plot_lines_style .~ lineStyle (opaque green)+	   $ plot_lines_values .~ [[ (d, v) | (d,_,v) <- prices]]+           $ plot_lines_title .~ "price 2"+           $ def++    (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 = layoutlr_title .~"Price History"+           $ layoutlr_background .~ solidFillStyle bg+           $ layoutlr_axes_styles %~ (axis_grid_style .~ solidLine 1 fg1)+           $ layoutlr_left_axis . laxis_override .~ axisGridHide+           $ layoutlr_right_axis . laxis_override .~ axisGridHide+           $ layoutlr_x_axis . laxis_override .~ axisGridHide+ 	   $ layoutlr_plots .~ ([Left (toPlot price1), Right (toPlot price2)] ++ limits)+           $ layoutlr_grid_last .~ False+           $ layoutlr_foreground .~ fg+           $ def++updateCanvas :: Renderable a -> G.DrawingArea -> IORef (Maybe (PickFn a)) -> IO Bool+updateCanvas chart canvas pickfv = do+    win <- G.widgetGetDrawWindow canvas+    (width, height) <- G.widgetGetSize canvas+    let sz = (fromIntegral width,fromIntegral height)+    pickf <- G.renderWithDrawable win $ runBackend (defaultEnv bitmapAlignmentFns) (render chart sz)+    writeIORef pickfv (Just pickf)+    return True++createRenderableWindow :: (Show a) => Renderable a -> Int -> Int -> IO G.Window+createRenderableWindow chart windowWidth windowHeight = do+    pickfv <- newIORef Nothing+    window <- G.windowNew+    canvas <- G.drawingAreaNew+    G.widgetSetSizeRequest window windowWidth windowHeight+    G.onExpose canvas $ const (updateCanvas chart canvas pickfv)+    G.onButtonPress canvas $ \(GE.Button{GE.eventX=x,GE.eventY=y}) -> do+        print (x,y)+        (Just pickf) <- readIORef pickfv+        print (pickf (Point x y))+        return True+    G.set window [G.containerChild G.:= canvas]+    return window++chartWindow = do+    window <- createRenderableWindow (chart prices2 True 1.00) 640 480+    G.onDestroy window G.mainQuit+    G.widgetShowAll window+    G.mainGUI++gridWindow = do+    window <- createRenderableWindow (gridToRenderable testgrid) 640 480+    G.onDestroy window G.mainQuit+    G.widgetShowAll window+    G.mainGUI+  where+    testgrid :: Grid (Renderable String)+    testgrid = aboveN+        [ besideN [ f "AAAAA", e, f "BBBBB" ]+        , besideN [ f "CCCCC", e, f "DDDDD" ]+        ]+    f s = tval $ setPickFn (const (Just s)) $ label def HTA_Centre VTA_Centre s+    e = tval $ spacer (20,20)+++main = do+  G.initGUI+  chartWindow

@@ -0,0 +1,70 @@+module Main where+++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Backend.Cairo++import System.Environment(getArgs,getProgName)+import qualified GtkTestPicking+import qualified DiagramsCairo+import qualified DiagramsSVG+import qualified DiagramsEPS+import qualified CompareFonts+import qualified Drawing.Cairo+import qualified Drawing.DiagramsCairo++import Control.Monad+import Tests++chooseLineWidth PNG = 1.0+chooseLineWidth PDF = 0.25+chooseLineWidth PS = 0.25+chooseLineWidth SVG = 0.25++main = do+    args <- getArgs+    main1 args++main1 :: [String] -> IO ()+main1 ("charts-cairo":"--pdf":tests) = renderTestsToFiles PDF ".pdf" tests+main1 ("charts-cairo":"--svg":tests) = renderTestsToFiles SVG ".svg" tests+main1 ("charts-cairo":"--ps":tests) = renderTestsToFiles PS ".ps" tests+main1 ("charts-cairo":"--png":tests) = renderTestsToFiles PNG ".png" tests++main1 ("charts-diagrams":"--cairo":args) = DiagramsCairo.main1 args+main1 ("charts-diagrams":"--svg":args) = DiagramsSVG.main1 args+main1 ("charts-diagrams":"--eps":args) = DiagramsEPS.main1 args++main1 ("drawing-cairo":[]) = Drawing.Cairo.main+main1 ("drawing-diagrams":[]) = Drawing.DiagramsCairo.main++main1 ("compare-fonts":[]) = CompareFonts.main+main1 ("gtk-picking":[]) = GtkTestPicking.main++main1 _ = usage++usage :: IO ()+usage = do+  progname <- getProgName +  putStrLn "Usage:"+  putStrLn $ "  " ++ progname ++ " charts-cairo (--pdf|--svg|--ps|--png) chart-name..."+  putStrLn $ "  " ++ progname ++ " charts-diagrams (--cairo|--svg|--eps) chart-name..."+  putStrLn $ "  " ++ progname ++ " drawing-cairo"+  putStrLn $ "  " ++ progname ++ " drawing-diagrams"+  putStrLn $ "  " ++ progname ++ " compare-fonts"+  putStrLn $ "  " ++ progname ++ " gtk-picking"++chartsCairo :: [String] -> IO ()+chartsCairo ("--pdf":tests) = renderTestsToFiles PDF ".pdf" tests+chartsCairo ("--svg":tests) = renderTestsToFiles SVG ".svg" tests+chartsCairo ("--ps":tests) = renderTestsToFiles PS ".ps" tests+chartsCairo ("--png":tests) = renderTestsToFiles PNG ".png" tests+chartsCairo (tests) = renderTestsToFiles PNG ".png" tests++renderTestsToFiles :: FileFormat -> String -> [String] -> IO ()+renderTestsToFiles fmt suffix tests = mapM_ doTest (getTests tests)+  where+    doTest (n,sz,rf) = do+      let f = n++suffix+      putStrLn (f ++ "...")+      void $ renderableToFile (FileOptions sz fmt) f (rf (chooseLineWidth fmt))

@@ -0,0 +1,392 @@+module 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)))+

@@ -0,0 +1,38 @@+module Test1 where ++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Data.Colour.SRGB+import Control.Lens+import Data.Default.Class++import Utils++chart :: Double -> Renderable (LayoutPick Double Double Double)+chart lwidth = layoutToRenderable (layout lwidth)++layout :: Double -> Layout Double Double+layout lwidth = layout'+  where+    layout' = layout_title .~ "Amplitude Modulation"+            $ layout_plots .~ [ toPlot sinusoid1+                              , toPlot sinusoid2 ]+            $ layout_plot_background .~ Just (solidFillStyle $ opaque white)+            $ def++    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"+              $ def++    sinusoid2 = plot_points_style .~ filledCircles 2 (opaque red)+              $ plot_points_values .~ [ (x,(am x)) | x <- [0,7..400]]+              $ plot_points_title .~"am points"+              $ def++-- main = main' "test1" (chart 0.25)++

@@ -0,0 +1,45 @@+module Test14 where ++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class+import Data.Time.LocalTime+import System.Random+import Prices(prices1)++import Utils++-- demonstrate AreaSpots++chart :: Double -> Renderable (LayoutPick LocalTime Double Double)+chart lwidth = layoutToRenderable layout+  where+    layout = layout_title .~"Price History"+           $ layout_background .~ solidFillStyle (opaque white)+           $ layout_left_axis_visibility . axis_show_ticks .~ False+ 	   $ layout_plots .~ [ toPlot price1, toPlot spots ]+           $ layout_foreground .~ opaque black+           $ def++    price1 = plot_lines_style .~ lineStyle+           $ plot_lines_values .~ [[ (d, v) | (d,v,_) <- prices1]]+           $ plot_lines_title .~ "price 1"+           $ def++    spots = area_spots_title .~ "random value"+          $ area_spots_max_radius .~ 20+          $ area_spots_values .~ values+          $ def+    +    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+              $ def ^. plot_lines_style++-- main = main' "test14" (chart 0.25)

@@ -0,0 +1,47 @@+module Test14a where ++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Plot+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class+import Data.Time.LocalTime+import System.Random+import Prices(prices1)++import Utils++-- demonstrate AreaSpots4D++chart :: Double -> Renderable (LayoutPick LocalTime Double Double)+chart lwidth = layoutToRenderable layout+  where+    layout = layout_title .~"Price History"+           $ layout_background .~ solidFillStyle (opaque white)+           $ layout_left_axis_visibility . axis_show_ticks .~ False+ 	   $ layout_plots .~ [ toPlot price1, toPlot spots ]+           $ layout_foreground .~ opaque black+           $ def++    price1 = plot_lines_style .~ lineStyle+           $ plot_lines_values .~ [[ (d, v) | (d,v,_) <- prices1]]+           $ plot_lines_title .~ "price 1"+           $ def++    spots = area_spots_4d_title .~ "random value"+          $ area_spots_4d_max_radius .~ 20+          $ area_spots_4d_values .~ values+          $ def+    +    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+              $ def ^. plot_lines_style++-- main = main' "test14" (chart 0.25)

@@ -0,0 +1,43 @@+module Test15 where ++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class++import Utils++chart lo lp = layoutToRenderable layout+ where+  layout = +        layout_title .~ "Legend Test"+      $ layout_title_style . font_size .~ 10+      $ layout_x_axis . laxis_generate .~ autoIndexAxis alabels+      $ layout_y_axis . laxis_override .~ axisGridHide+      $ layout_left_axis_visibility . axis_show_ticks .~ False+      $ layout_plots .~ [ plotBars bars2 ]+      $ layout_legend .~ Just lstyle+      $ def :: Layout 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)+      $ def++  alabels = [ "X", "Y" ]++  lstyle = legend_orientation .~ lo+         $ legend_position .~ lp+         $ def++  btitle = ""+  mkstyle c = (solidFillStyle c, Nothing)++-- main = main' "test15" (chart (LORows 3))++

@@ -0,0 +1,79 @@+module Test17 where ++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class+import Data.Time.LocalTime+import System.Random+import ExampleStocks++import Utils++-- demonstrate Candles++chart :: Double -> Renderable (LayoutPick LocalTime Double Double)+chart lwidth = layoutLRToRenderable layout+  where+    layout = layoutlr_title .~"Stock Prices"+           $ layoutlr_background .~ solidFillStyle (opaque white)+           $ layoutlr_left_axis_visibility . axis_show_ticks .~ False+ 	   $ layoutlr_plots .~ [ Right (toPlot msftArea)+                               , Right (toPlot msftLine)+                               , Right (toPlot msftCandle)+                               , Left  (toPlot aaplArea)+                               , Left  (toPlot aaplLine)+                               , Left  (toPlot aaplCandle) ]+           $ layoutlr_foreground .~ opaque black+           $ def++    aaplLine = plot_lines_style  .~ lineStyle 2 green+             $ plot_lines_values .~ [[ (d, cl)+                                     | (d,(lo,op,cl,hi)) <- pricesAAPL]]+             $ plot_lines_title  .~ "AAPL closing"+             $ def++    msftLine = plot_lines_style  .~ lineStyle 2 purple+             $ plot_lines_values .~ [[ (d, cl)+                                     | (d,(lo,op,cl,hi)) <- pricesMSFT]]+             $ plot_lines_title  .~ "MSFT closing"+             $ def++    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"+             $ def++    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"+             $ def++    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"+               $ def++    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"+               $ def++    lineStyle n colour = line_width .~ n * lwidth+                       $ line_color .~ opaque colour+                       $ def ^. plot_lines_style++-- main = main' "test17" (chart 0.25)

@@ -0,0 +1,28 @@+module Test19 where++import Graphics.Rendering.Chart.Easy+import Control.Lens+import System.Random+import Data.Default.Class++samples :: [Double]+samples = zipWith (+) raw (tail raw)+  where+    raw = take 2000 (randomRs (0,50) (mkStdGen 0))++samples2 :: [Double]+samples2 = concat $ zipWith replicate [5, 4, 3, 7] [0..3]++chart = toRenderable $+  plot $ fmap histToPlot $ liftEC $ do+      plot_hist_title .= "Demo histogram"+      plot_hist_bins .= 100+      plot_hist_values .= samples+      plot_hist_norm_func .= const id++chart2 :: Renderable ()+chart2 = toRenderable $+  plot $ fmap histToPlot $ liftEC $ do+      plot_hist_bins .= 4+      plot_hist_values .= samples2+      plot_hist_norm_func .= const id

@@ -0,0 +1,63 @@+module Test2 where++import Graphics.Rendering.Chart+import Data.Time.LocalTime+import Data.Colour+import Data.Colour.Names+import Data.Colour.SRGB+import Control.Lens+import Data.Default.Class+import Prices(prices2)++import Utils++chart :: [(LocalTime,Double,Double)] -> Bool -> Double -> Renderable (LayoutPick LocalTime Double Double)+chart prices showMinMax lwidth = layoutLRToRenderable $ chartLR prices showMinMax lwidth+  +chartLR :: [(LocalTime,Double,Double)] -> Bool -> Double -> LayoutLR LocalTime Double Double+chartLR prices showMinMax lwidth = layout+  where++    lineStyle c = line_width .~ 3 * lwidth+                $ line_color .~ c+                $ def ^. plot_lines_style++    limitLineStyle c = line_width .~ lwidth+                $ line_color .~ opaque c+                $ line_dashes .~ [5,10]+                $ def ^. plot_lines_style++    price1 = plot_lines_style .~ lineStyle (opaque blue)+           $ plot_lines_values .~ [[ (d, v) | (d,v,_) <- prices]]+           $ plot_lines_title .~ "price 1"+           $ def++    price2 = plot_lines_style .~ lineStyle (opaque green)+	   $ plot_lines_values .~ [[ (d, v) | (d,_,v) <- prices]]+           $ plot_lines_title .~ "price 2"+           $ def++    (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 = layoutlr_title .~"Price History"+           $ layoutlr_background .~ solidFillStyle bg+           $ layoutlr_axes_styles %~ (axis_grid_style .~ solidLine 1 fg1)+           $ layoutlr_left_axis . laxis_override .~ axisGridHide+           $ layoutlr_right_axis . laxis_override .~ axisGridHide+           $ layoutlr_x_axis . laxis_override .~ axisGridHide+ 	   $ layoutlr_plots .~ ([Left (toPlot price1), Right (toPlot price2)] ++ limits)+           $ layoutlr_grid_last .~ False+           $ layoutlr_foreground .~ fg+           $ def++-- main = main' "test2" (chart prices2 True 0.25)

@@ -0,0 +1,36 @@+module Test3 where++import Graphics.Rendering.Chart+import Data.Time.LocalTime+import Data.Colour+import Data.Colour.Names+import Data.Colour.SRGB+import Control.Lens+import Data.Default.Class+import Prices(prices1)++import Utils++green1 = opaque $ sRGB 0.5 1 0.5+blue1 = opaque $ sRGB 0.5 0.5 1++chart :: Renderable (LayoutPick LocalTime Double Double)+chart = layoutToRenderable layout+  where+    price1 = plot_fillbetween_style .~ solidFillStyle green1+           $ plot_fillbetween_values .~ [ (d,(0,v2)) | (d,v1,v2) <- prices1]+           $ plot_fillbetween_title .~ "price 1"+           $ def++    price2 = plot_fillbetween_style .~ solidFillStyle blue1+           $ plot_fillbetween_values .~ [ (d,(0,v1)) | (d,v1,v2) <- prices1]+           $ plot_fillbetween_title .~ "price 2"+           $ def++    layout = layout_title .~ "Price History"+           $ layout_grid_last .~ True+           $ layout_plots .~ [ toPlot price1+                             , toPlot price2 ]+           $ def++-- main = main' "test3" chart

@@ -0,0 +1,35 @@+module Test4 where ++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class++import Utils++chart :: Bool -> Bool -> Renderable (LayoutPick Double Double Double)+chart xrev yrev = layoutToRenderable 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"+           $ def++    lines = plot_lines_values .~ [ [(x, 10**x) | x <- [0,3]] ]+          $ plot_lines_title .~ "values"+          $ def++    layout = layout_title .~ "Log/Linear Example"+           $ layout_x_axis . laxis_title .~ "horizontal"+           $ layout_x_axis . laxis_reverse .~ xrev+           $ layout_y_axis . laxis_generate .~ autoScaledLogAxis def+           $ layout_y_axis . laxis_title .~ "vertical"+           $ layout_y_axis . laxis_reverse .~ yrev+           $ layout_plots .~ [ toPlot points, toPlot lines ]+           $ def++-- main = main' "test4" (chart False False)++

@@ -0,0 +1,46 @@+module Test5 where ++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class+import System.Random++import Utils++----------------------------------------------------------------------+-- Example thanks to Russell O'Connor++chart :: Double -> Renderable (LayoutPick Double LogValue LogValue)+chart lwidth = layoutToRenderable (layout 1001 (trial bits) :: Layout Double LogValue)+  where+    bits = randoms $ mkStdGen 0++    layout n t = layout_title .~ "Simulation of betting on a biased coin"+               $ layout_plots .~ [+                      toPlot (plot "f=0.05" s1 n 0 (t 0.05)),+                      toPlot (plot "f=0.1" s2 n 0 (t 0.1))+                     ]+               $ def++    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+                 $ def++    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++-- main = main' "test5" (chart 0.25)++

@@ -0,0 +1,32 @@+module Test7 where ++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class++import Utils++chart :: Renderable (LayoutPick Double Double Double)+chart = layoutToRenderable 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"+         $ def++    points = plot_points_style .~ filledCircles 2 (opaque red)+	   $ plot_points_values .~ [(x,y) |  (x,y,dx,dy) <- vals]+           $ plot_points_title .~ "test data"+           $ def++    layout = layout_title .~ "Error Bars"+           $ layout_plots .~ [ toPlot bars+                             , toPlot points ]+           $ def++-- main = main' "test7" chart++

@@ -0,0 +1,23 @@+module Test8 where ++import Graphics.Rendering.Chart+import Control.Lens+import Data.Default.Class++import Utils++chart :: Renderable ()+chart = mapPickFn (const ()) $ pieToRenderable 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 .~ [ def{_pitem_value=v,_pitem_label=s,_pitem_offset=o}+                                      | (s,v,o) <- values ]+           $ pie_plot . pie_label_style .~ (font_size .~ 20 $ def)+           $ def++-- main = main' "test8" chart++

@@ -0,0 +1,38 @@+module Test9 where ++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class++import Utils++chart :: Bool -> Renderable (LayoutPick PlotIndex Double Double)+chart borders = layoutToRenderable layout+ where+  layout = +        layout_title .~ "Sample Bars" ++ btitle+      $ layout_title_style . font_size .~ 10+      $ layout_x_axis . laxis_generate .~ autoIndexAxis alabels+      $ layout_y_axis . laxis_override .~ axisGridHide+      $ layout_left_axis_visibility . axis_show_ticks .~ False+      $ layout_plots .~ [ plotBars bars2 ]+      $ def :: Layout 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)+      $ def++  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)++-- main = main' "test9" (chart True)++

@@ -0,0 +1,27 @@+module TestParametric where++import Graphics.Rendering.Chart+import Data.Colour+import Data.Colour.Names+import Control.Lens+import Data.Default.Class++import Utils++chart :: Double -> Renderable (LayoutPick Double Double Double)+chart lwidth = layoutToRenderable 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) +            $ def++    layout = layout_title .~ "Parametric Plot"+           $ layout_plots .~ [toPlot circleP]+           $ def++-- main = main' "test1" (chart 0.25)

@@ -0,0 +1,30 @@+module TestSparkLines where ++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.SparkLine+import Data.Colour+import Data.Colour.Names+import Control.Lens+import System.Random+import System.Environment(getArgs)+import ExampleStocks++-- demonstrate SparkLine++msft = SparkLine { sl_options = smoothSpark { so_limits=(bot,top), so_height=40 }+                 , sl_data    = closing }+  where+    closing  = [ cl | (d,(lo,op,cl,hi)) <- reverse pricesMSFT ]+    lowpoint = [ lo | (d,(lo,op,cl,hi)) <- reverse pricesMSFT ]+    bot = minimum lowpoint+    top = maximum closing++chart :: Renderable ()+chart = sparkLineToRenderable msft+chartSize = sparkSize msft+{- Cairo dependent+main1 :: [String] -> IO (PickFn ())+main1 _  = sparkLineToPNG "test_sparkline.png" msft++main = getArgs >>= main1+-}

@@ -0,0 +1,498 @@++module Tests where++import Graphics.Rendering.Chart+import Graphics.Rendering.Chart.Drawing+import Graphics.Rendering.Chart.Grid++import System.Time+import System.Random+import Data.Time.LocalTime+import Control.Lens+import Data.Char (chr)+import Data.Colour+import Data.Colour.Names+import Data.Colour.SRGB+import Data.List(sort,nub,scanl1)+import Data.Default.Class+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 Test7+import qualified Test8+import qualified Test9+import qualified Test14+import qualified Test14a+import qualified Test15+import qualified Test17+import qualified Test19+import qualified TestParametric+import qualified TestSparkLines++type LineWidth = Double++fwhite = solidFillStyle $ opaque white++test1a :: Double -> Renderable (LayoutPick Double Double Double)+test1a lwidth = fillBackground fwhite $ (gridToRenderable t)+  where+    t = aboveN [ besideN [layoutToGrid l1, layoutToGrid l2, layoutToGrid l3],+                 besideN [layoutToGrid l4, layoutToGrid l5, layoutToGrid l6] ]++    l1 = layout_title .~ "minimal"+       $ layout_bottom_axis_visibility . axis_show_ticks .~ False+       $ layout_left_axis_visibility   . axis_show_ticks .~ False+       $ layout_x_axis . laxis_override .~ axisGridHide+       $ layout_y_axis . laxis_override .~ axisGridHide+       $ Test1.layout lwidth++    l2 = layout_title .~ "with borders"+       $ layout_bottom_axis_visibility . axis_show_ticks .~ False+       $ layout_left_axis_visibility   . axis_show_ticks .~ False+       $ layout_top_axis_visibility    . axis_show_line   .~ True+       $ layout_right_axis_visibility  . axis_show_line   .~ True+       $ layout_x_axis . laxis_override .~ axisGridHide+       $ layout_y_axis . laxis_override .~ axisGridHide+       $ Test1.layout lwidth++    l3 = layout_title .~ "default"+       $ Test1.layout lwidth++    l4 = layout_title .~ "tight grid"+       $ layout_y_axis . laxis_generate .~ axis+       $ layout_y_axis . laxis_override .~ axisGridAtTicks+       $ layout_x_axis . laxis_generate .~ axis+       $ layout_x_axis . laxis_override .~ axisGridAtTicks+       $ Test1.layout lwidth+      where+        axis = autoScaledAxis (+            la_nLabels .~ 5+          $ la_nTicks .~ 20+          $ def+          )++    l5 = layout_title .~ "y linked"+       $ layout_right_axis_visibility . axis_show_line   .~ True+       $ layout_right_axis_visibility . axis_show_ticks  .~ True+       $ layout_right_axis_visibility . axis_show_labels .~ True+       $ Test1.layout lwidth++    l6 = layout_title .~ "everything"+       $ layout_right_axis_visibility . axis_show_line   .~ True+       $ layout_right_axis_visibility . axis_show_ticks  .~ True+       $ layout_right_axis_visibility . axis_show_labels .~ True+       $ layout_top_axis_visibility . axis_show_line   .~ True+       $ layout_top_axis_visibility . axis_show_ticks  .~ True+       $ layout_top_axis_visibility . axis_show_labels .~ True+       $ Test1.layout lwidth++----------------------------------------------------------------------+test4d :: LineWidth -> Renderable (LayoutPick Double Double Double)+test4d lw = layoutToRenderable 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"+           $ def++    lines = plot_lines_values .~ [ [(x, 10**x) | x <- [0,3]] ]+          $ plot_lines_title .~ "values"+          $ def++    layout = layout_title .~ "Log/Linear Example"+           $ layout_x_axis . laxis_title .~ "horizontal"+           $ layout_x_axis . laxis_reverse .~ False+           $ layout_y_axis . laxis_generate .~ autoScaledLogAxis def+           $ layout_y_axis . laxis_title .~ "vertical"+           $ layout_y_axis . laxis_reverse .~ False+	   $ layout_plots .~ [ toPlot points `joinPlot` toPlot lines ]+           $ def++----------------------------------------------------------------------++test9 :: PlotBarsAlignment -> LineWidth -> Renderable (LayoutPick PlotIndex Double Double)+test9 alignment lw = 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 . layoutToRenderable++    alabels = [ "Jun", "Jul", "Aug", "Sep", "Oct" ]+++    layout title bars =+             layout_title .~ (show alignment ++ "/" ++ title)+           $ layout_title_style . font_size .~ 10+           $ layout_x_axis . laxis_generate .~ autoIndexAxis alabels+           $ layout_y_axis . laxis_override .~ axisGridHide+           $ layout_left_axis_visibility . axis_show_ticks .~ False+           $ layout_plots .~ [ plotBars bars ]+           $ def :: Layout PlotIndex Double++    bars1 = plot_bars_titles .~ ["Cash"]+          $ plot_bars_values .~ addIndexes [[20],[45],[30],[70]]+          $ plot_bars_alignment .~ alignment+          $ def++    bars2 = plot_bars_titles .~ ["Cash","Equity"]+          $ plot_bars_values .~ addIndexes [[20,45],[45,30],[30,20],[70,25]]+          $ plot_bars_alignment .~ alignment+          $ def++-------------------------------------------------------------------------------++test10 :: [(LocalTime,Double,Double)] -> LineWidth -> Renderable (LayoutPick LocalTime Double Double)+test10 prices lw = layoutLRToRenderable $ test10LR prices lw++test10LR :: [(LocalTime,Double,Double)] -> LineWidth -> LayoutLR LocalTime Double Double+test10LR prices lw = layout+  where++    lineStyle c = line_width .~ 3 * lw+                $ line_color .~ c+                $ def ^. plot_lines_style++    price1 = plot_lines_style .~ lineStyle (opaque blue)+           $ plot_lines_values .~ [[ (d,v) | (d,v,_) <- prices]]+           $ plot_lines_title .~ "price 1"+           $ def++    price1_area = plot_fillbetween_values .~ [(d, (v * 0.95, v * 1.05)) | (d,v,_) <- prices]+                $ plot_fillbetween_style  .~ solidFillStyle (withOpacity blue 0.2)+                $ def++    price2 = plot_lines_style .~ lineStyle (opaque red)+	   $ plot_lines_values .~ [[ (d, v) | (d,_,v) <- prices]]+           $ plot_lines_title .~ "price 2"+           $ def++    price2_area = plot_fillbetween_values .~ [(d, (v * 0.95, v * 1.05)) | (d,_,v) <- prices]+                $ plot_fillbetween_style  .~ solidFillStyle (withOpacity red 0.2)+                $ def++    fg = opaque black+    fg1 = opaque $ sRGB 0.0 0.0 0.15++    layout = layoutlr_title .~"Price History"+           $ layoutlr_background .~ solidFillStyle (opaque white)+           $ layoutlr_right_axis . laxis_override .~ axisGridHide+ 	   $ layoutlr_plots .~ [ Left (toPlot price1_area), Right (toPlot price2_area)+                               , Left (toPlot price1),      Right (toPlot price2)+                               ]+           $ layoutlr_foreground .~ fg+           $ def++-------------------------------------------------------------------------------+-- A quick test of stacked layouts++test11_ f = f layout1 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) ]++    plot1 = plot_points_style .~ filledCircles 5 (opaque red)+          $ plot_points_values .~ vs1+          $ plot_points_title .~ "spots"+          $ def++    layout1 = layout_title .~ "Multi typed stack"+            $ layout_plots .~ [toPlot plot1]+            $ layout_y_axis . laxis_title .~ "integer values"+            $ def++    plot2 = plot_lines_values .~ [vs2]+          $ plot_lines_title .~ "lines"+          $ def++    layout2 = layout_plots .~ [toPlot plot2]+            $ layout_y_axis . laxis_title .~ "double values"+            $ def++mkStack ls f = +  renderStackedLayouts +  $ slayouts_layouts .~ ls+  $ slayouts_compress_legend .~ f+  $ def++test11a :: LineWidth -> Renderable ()+test11a lw = test11_ f+   where+     f l1 l2 = mkStack [StackedLayout l1, StackedLayout l2] False+ +test11b :: LineWidth -> Renderable ()+test11b lw = test11_ f+  where+    f l1 l2 = mkStack [StackedLayout l1', StackedLayout l2] True+      where+        l1' = layout_bottom_axis_visibility . axis_show_labels .~ False+            $ l1++-- should produce the same output as test10+test11c :: LineWidth -> Renderable ()+test11c lw =   +  mkStack [ StackedLayoutLR (test10LR prices1 lw)] True++test11d :: LineWidth -> Renderable ()+test11d lw =   +  mkStack [ StackedLayoutLR (Test2.chartLR prices1 False lw)+          , StackedLayoutLR (test10LR prices1 lw)+          ] False++test11e :: LineWidth -> Renderable ()+test11e lw =   +  let l2 = Test2.chartLR prices1 False lw+      b = opaque black+      -- how to use lens to get inside the maybe?+      l2' = -- layoutlr_legend . Just . legend_label_style . font_color .~ b+            layoutlr_legend .~ Just ((legend_label_style . font_color .~ b) $ def)+            $ (layoutlr_axes_styles %~ c) l2+      c as = axis_line_style .~ solidLine 1 b+             $ axis_label_style . font_color .~ b+             $ as+  in mkStack [ StackedLayoutLR (test10LR prices1 lw)+             , StackedLayoutLR l2'+             ] True++-------------------------------------------------------------------------------+-- More of an example that a test:+-- configuring axes explicitly configured axes++test12 :: LineWidth -> Renderable (LayoutPick Int Int Int)+test12 lw = layoutToRenderable layout+  where+    vs1 :: [(Int,Int)]+    vs1 = [ (2,10), (3,40), (8,400), (12,60) ]++    baxis = AxisData {+        _axis_visibility = def,+        _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_visibility = def,+        _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]+         $ def++    layout = layout_plots .~ [toPlot plot]+           $ layout_x_axis . laxis_generate .~ const baxis+           $ layout_y_axis . laxis_generate .~ const laxis+           $ layout_title .~ "Explicit Axes"+           $ def+++-------------------------------------------------------------------------------+-- Plot annotations test++test13 lw = 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]+                $  def+    p = toPlot pointPlot+    annotated h v = layoutToRenderable ( layout_plots .~ [toPlot labelPlot, toPlot rotPlot, p] $ def )+      where labelPlot = plot_annotation_hanchor .~ h+                      $ plot_annotation_vanchor .~ v+                      $ plot_annotation_values  .~ [(x,x,"Hello World\n(plain)")|x<-points]+                      $ def+            rotPlot =   plot_annotation_angle .~ -45.0+                      $ plot_annotation_style .~ def {_font_size=10, _font_weight=FontWeightBold, _font_color=(opaque blue) }+                      $ plot_annotation_values  .~ [(x,x,"Hello World\n(fancy)")|x<-points]+                      $ labelPlot+++----------------------------------------------------------------------+-- Vector Plot Test++test18 :: Renderable (LayoutPick Double Double Double)+test18 = layoutToRenderable layout+  where+    grid = [(x,y) | x <- range, y <- range] where range = [-5,-4..5]++    proj1 = plot_vectors_style . vector_head_style . point_color .~ (opaque green)+          $ plot_vectors_mapf .~ (\(x,y) -> (-x,-y))+          $ plot_vectors_grid .~ grid+          $ plot_vectors_title .~ "Projection1"+          $ def++    proj2 = plot_vectors_mapf .~ (\(x,y) -> (-(x+1), -(y-1)))+          $ plot_vectors_grid .~ grid+          $ plot_vectors_title .~ "Projection2"+          $ def++    layout = layout_title .~ "Vector Plot: Abyss"+           $ layout_plots .~ plotVectorField `liftM` [proj1,proj2]+           $ def++----------------------------------------------------------------------+-- a quick test to display labels with all combinations+-- of anchors+misc1 fsz rot lw = 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 = if rot == 0+        then "Labelling"+        else "Angle " ++ show (floor rot :: Int) ++ [chr 176]+    hs = [HTA_Left, HTA_Centre, HTA_Right]+    vs = [VTA_Top, VTA_Centre, VTA_Bottom, VTA_BaseLine]+    fwhite = solidFillStyle $ opaque white+    fblue = solidFillStyle $ withOpacity (sRGB 0.8 0.8 1) 0.6+    fs = def {_font_size=fsz,_font_weight=FontWeightBold}+    crossHairs r =Renderable {+      minsize = minsize r,+      render = \sz@(w,h) -> do+          let xa = w / 2+          let ya = h / 2+          alignStrokePoints [Point 0 ya,Point w ya] >>= strokePointPath +          alignStrokePoints [Point xa 0,Point xa h] >>= strokePointPath +          render r sz+    }++----------------------------------------------------------------------+stdSize = (640,480)++allTests :: [ (String, (Int,Int), LineWidth -> Renderable ()) ]+allTests =+     [ ("test1",  stdSize, \lw -> simple $ Test1.chart lw )+     , ("test1a", stdSize, \lw -> simple $ test1a lw )+     , ("test2a", stdSize, \lw -> simple $ Test2.chart prices    False lw)+     , ("test2b", stdSize, \lw -> simple $ Test2.chart prices1   False lw)+     , ("test2c", stdSize, \lw -> simple $ Test2.chart prices2   False lw)+     , ("test2d", stdSize, \lw -> simple $ Test2.chart prices5   True  lw)+     , ("test2e", stdSize, \lw -> simple $ Test2.chart prices6   True  lw)+     , ("test2f", stdSize, \lw -> simple $ Test2.chart prices7   True  lw)+     , ("test2g", stdSize, \lw -> simple $ Test2.chart prices3   False lw)+     , ("test2h", stdSize, \lw -> simple $ Test2.chart prices8   True  lw)+     , ("test2i", stdSize, \lw -> simple $ Test2.chart prices9   True  lw)+     , ("test2j", stdSize, \lw -> simple $ Test2.chart prices10  True  lw)+     , ("test2k", stdSize, \lw -> simple $ Test2.chart prices10a True  lw)+     , ("test2m", stdSize, \lw -> simple $ Test2.chart prices11  True  lw)+     , ("test2n", stdSize, \lw -> simple $ Test2.chart prices10b True  lw)+     , ("test2o", stdSize, \lw -> simple $ Test2.chart prices12  True  lw)+     , ("test2p", stdSize, \lw -> simple $ Test2.chart prices13  True  lw)+     , ("test2q", stdSize, \lw -> simple $ Test2.chart prices13a True  lw)+     , ("test2r", stdSize, \lw -> simple $ Test2.chart prices13b True  lw)+     , ("test2s", stdSize, \lw -> simple $ Test2.chart prices14  True  lw)+     , ("test2t", stdSize, \lw -> simple $ Test2.chart prices14a True  lw)+     , ("test2u", stdSize, \lw -> simple $ Test2.chart prices14b True  lw)+     , ("test2v", stdSize, \lw -> simple $ Test2.chart prices14c True  lw)+     , ("test2w", stdSize, \lw -> simple $ Test2.chart prices14d True  lw)+     , ("test3",  stdSize, const $ simple Test3.chart)+     , ("test4a", stdSize, const $ simple (Test4.chart False False))+     , ("test4b", stdSize, const $ simple (Test4.chart True False))+     , ("test4c", stdSize, const $ simple (Test4.chart False True))+     , ("test4d", stdSize, \lw -> simple $ test4d lw)+     , ("test5",  stdSize, \lw -> simple $ Test5.chart lw)+     , ("test7",  stdSize, const $ simple Test7.chart)+     , ("test8",  stdSize, const $ simple Test8.chart)+     , ("test9",  stdSize, const $ simple (Test9.chart True))+     , ("test9b", stdSize, const $ simple (Test9.chart False))+     , ("test9c", stdSize, \lw -> simple $ test9 BarsCentered lw)+     , ("test9l", stdSize, \lw -> simple $ test9 BarsLeft lw)+     , ("test9r", stdSize, \lw -> simple $ test9 BarsRight lw)+     , ("test10", stdSize, \lw -> simple $ test10 prices1 lw)+     , ("test11a", stdSize, \lw -> simple $ test11a lw)+     , ("test11b", stdSize, \lw -> simple $ test11b lw)+     , ("test11c", stdSize, \lw -> simple $ test11c lw)+     , ("test11d", stdSize, \lw -> simple $ test11d lw)+     , ("test11e", stdSize, \lw -> simple $ test11e lw)+     , ("test12", stdSize, \lw -> simple $ test12 lw)+     , ("test13", stdSize, \lw -> simple $ test13 lw)+     , ("test14", stdSize, \lw -> simple $ Test14.chart lw )+     , ("test14a", stdSize, \lw -> simple $ Test14a.chart lw )+     , ("test15a", stdSize, const $ simple (Test15.chart (LORows 2) LegendBelow))+     , ("test15b", stdSize, const $ simple (Test15.chart (LOCols 2) LegendBelow))+     , ("test15c", stdSize, const $ simple (Test15.chart (LORows 2) LegendLeft))+     , ("test15d", stdSize, const $ simple (Test15.chart (LORows 2) LegendRight))+     , ("test15e", stdSize, const $ simple (Test15.chart (LOCols 2) LegendAbove))+     , ("test17", stdSize,  \lw -> simple $ Test17.chart lw)+     , ("test18", stdSize, const $ simple test18)+     , ("test19", stdSize, const $ simple Test19.chart)+     , ("test19b", stdSize, const $ simple Test19.chart2)+     , ("misc1",  stdSize, setPickFn nullPickFn . misc1 20 0)+       -- perhaps a bit excessive+     , ("misc1a", stdSize, setPickFn nullPickFn . misc1 12 45)+     , ("misc1b", stdSize, setPickFn nullPickFn . misc1 12 90)+     , ("misc1c", stdSize, setPickFn nullPickFn . misc1 12 135)+     , ("misc1d", stdSize, setPickFn nullPickFn . misc1 12 180)+     , ("misc1e", stdSize, setPickFn nullPickFn . misc1 12 205)+     , ("misc1f", stdSize, setPickFn nullPickFn . misc1 12 270)+     , ("misc1g", stdSize, setPickFn nullPickFn . misc1 12 315)+     , ("parametric", stdSize, \lw -> simple $ TestParametric.chart lw )+     , ("sparklines", TestSparkLines.chartSize, const $ simple TestSparkLines.chart )+     ]+  where simple :: Renderable a -> Renderable ()+        simple = mapPickFn (const ())++++showTests :: [String] -> ((String,(Int,Int),LineWidth -> Renderable ()) -> IO()) -> IO ()+showTests tests ofn = mapM_ doTest (filter (match tests) allTests)+   where+     doTest (s,size,f) = do+       putStrLn (s ++ "... ")+       ofn (s,size,f)+     ++getTests :: [String] -> [(String,(Int,Int),LineWidth -> Renderable ())]+getTests names = filter (match names) allTests++match :: [String] -> (String,s,a) -> Bool+match [] t = True+match ts (s,_,_) = s `elem` ts

@@ -0,0 +1,12 @@+module Utils where++import System.Environment(getArgs)+import Graphics.Rendering.Chart+{-+mainCairo :: String -> Renderable a -> [String] -> IO (PickFn a)+mainCairo name chart ["small"]  = renderableToPNGFile chart 320 240 $ name ++ "_small.png"+mainCairo name chart ["big"]    = renderableToPNGFile chart 800 600 $ name ++ "_big.png" ++main' :: String -> Renderable a -> IO (PickFn a)+main' name chart = getArgs >>= mainCairo name chart+-}