plot 0.2.1 → 0.2.2
raw patch · 16 files changed
+827/−232 lines, 16 files
Files
- CHANGES +5/−0
- THANKS +2/−0
- examples/Test.hs +169/−0
- examples/Test2.hs +194/−0
- examples/Test3.hs +130/−0
- lib/Graphics/Rendering/Plot/Figure.hs +49/−40
- lib/Graphics/Rendering/Plot/Figure/Plot.hs +48/−36
- lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs +39/−27
- lib/Graphics/Rendering/Plot/Render.hs +40/−31
- lib/Graphics/Rendering/Plot/Render/Plot.hs +5/−0
- lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs +52/−29
- lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +11/−7
- lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs +4/−1
- lib/Graphics/Rendering/Plot/Render/Types.hs +53/−48
- lib/Graphics/Rendering/Plot/Types.hs +19/−9
- plot.cabal +7/−4
CHANGES view
@@ -108,3 +108,8 @@ 0.2.1: * don't use textPad when plot title is empty * add background colours for figure and plot++0.2.2:+ * deprecate `withTickLabelFormat` for `withTickLabelsFormat`+ * fix issue #5, interaction of setPointSize and Legends+
THANKS view
@@ -1,3 +1,5 @@ * Nicolas Dudebout for linlog and loglin in Simple.hs * uriba for a small bug fix when setting ticks * buecking added the TickFormat data type and resulting code+ * takano-akio pointed out bug in interaction between + non-default point size and legend placement/scaling
+ examples/Test.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE UnicodeSyntax #-}++-- thanks to http://www.muitovar.com/gtk2hs/app1.html++--module Test where++import Control.Concurrent+import Control.Concurrent.MVar++import Control.Monad.Trans++import Graphics.UI.Gtk hiding(Circle,Cross)+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++import Data.Colour.Names++import Data.Packed.Vector+--import Data.Packed.Random+import Data.Packed()++--import Prelude.Unicode++import qualified Data.Array.IArray as A++import Numeric.LinearAlgebra++import Numeric.GSL.Statistics++import Graphics.Rendering.Plot++import Debug.Trace++ln = 25+ts = linspace ln (0,1)+rs = ln |> take ln [0.306399512330476,-0.4243863460546792,-0.20454667402138094,-0.42873761654774106,1.3054721019673694,0.6474765138733175,1.1942346875362946,-1.7404737823144103,0.2607101951530985,-0.26782584645524893,-0.31403631431884504,3.365508546473985e-2,0.6147856889630383,-1.191723225061435,-1.9933460981205509,0.6015225906539229,0.6394073044477114,-0.6030919788928317,0.1832742199706381,0.35532918011648473,0.1982646055874545,1.7928383756822786,-9.992760294442601e-2,-1.401166614128362,-1.1088031929569364,-0.827319908453775,1.0406363628775428,-0.3070345979284644,0.6781735212645198,-0.8431706723519456,-0.4245730055085966,-0.6503687925251668,-1.4775567962221399,0.5587634921497298,-0.6481020127107823,7.313441602898768e-2,0.573580543636529,-0.9036472376122673,2.650805059813826,9.329324044673039e-2,1.9133487025468563,-1.5366337588254542,-1.0159359710920388,7.95982933517428e-2,0.5813673663649735,-6.93329631989878e-2,1.1024137719307867,-0.6046286796589855,-0.8812842030098401,1.4612246471009083,0.9584060744500491,9.210899579679932e-2,-0.15850413664405813,-0.4754694827227343,0.8669922262489788,0.4593351854708853,-0.2015350278936992,0.8829710664887649,0.7195048491420026]++ss = sin (15*2*pi*ts)+ds = 0.25*rs + ss+es = constant (0.25*(stddev rs)) ln++fs :: Double -> Double+fs = sin . (15*2*pi*)++ms :: Matrix Double+ms = buildMatrix 64 64 (\(x,y) -> sin (2*2*pi*(fromIntegral x)/64) * cos (5*2*pi*(fromIntegral y)/64))++pts = linspace 1000 (0 :: Double,10*pi)+fx = (\t -> t * sin t) pts+fy = (\t -> t * cos t) pts++hx = fromList [1,3,5,8,11,20,22,26] :: Vector Double+hy = fromList [10,11,15,17,14,12,9] :: Vector Double++lx = fromList [1,2,3,4,5,6,7,8,9,10] ∷ Vector Double+ly = fromList [50000,10000,5000,1000,500,100,50,10,1] ∷ Vector Double++mx = linspace 100 (1,10) ∷ Vector Double+my = linspace 100 (1,10000) ∷ Vector Double++cx = fromList [1,2,3,4,5] ∷ Vector Double+cyl = fromList [8,10,12,13,8] ∷ Vector Double+cyu = fromList [10,12,16,5,10] ∷ Vector Double+cel = cyl - 1+ceu = cyu + 1++at = linspace 1000 (0,2*pi) ∷ Vector Double+ax = sin at+++figure = do+-- setPlots 1 1+{-+ withPlot (1,1) $ do+ setDataset [(Hist,hx,hy)]+ addAxis XAxis (Side Lower) $ return ()+ addAxis YAxis (Side Lower) $ return ()+-}{- setRange XAxis Lower (-4*pi) (1*pi)+ setRange YAxis Lower (-4*pi) (1*pi) -}+{- setRange XAxis Lower 0 32+ setRange YAxis Lower 0 20+-}+ withLineDefaults $ setLineWidth 2+ withTextDefaults $ setFontFamily "OpenSymbol"+ withTitle $ setText "Testing plot package:"+ withSubTitle $ do+ setText "with 1 second of a 15Hz sine wave"+ setFontSize 10+ setPlots 1 1++ withPlot (1,1) $ do++-- setDataset (ts,[area ds blue])+-- setDataset (ts,[impulse fs blue])+-- setDataset (ts,[point (ds,es,"Sampled data") (Bullet,green)+-- ,line (fs,"15 Hz sinusoid") blue])+-- setDataset [(Line,fx,fy)]+-- setDataset (ts,[bar (ds,"Sampled data") (10 :: Double,green,3:: Double,blue)+-- ,line (fs,"15 Hz sinusoid") blue])+-- setDataset [(Line,mx,my)]+-- setDataset (Whisker,cx,[((cyl,cyu),(cel,ceu))])+ setDataset (Line,at,[ax])+ addAxis XAxis (Side Lower) $ do+ setGridlines Major True+ withAxisLabel $ setText "time (s)"+ addAxis YAxis (Side Lower) $ do+ setGridlines Major True+ withAxisLabel $ setText "amplitude (α)"+-- addAxis XAxis (Value 0) $ return ()+ setRangeFromData XAxis Lower Linear+ setRangeFromData YAxis Lower Linear+ withAnnotations $ do+ arrow True (pi/2,0.5) (0,0) (return ())+ --oval True (0.5,1) (1,3) $ setBarColour blue+ rect True (0.5,0.5) (2,0.75) $ (return ())+ glyph (4,0.2) (return ())+ text (3,0.0) (setText "from the α to the Ω")+ cairo (\_ _ _ _ -> do+ C.moveTo 3 0.75+ C.lineTo 4 (-0.5)+ C.stroke+ )+-- setRange YAxis Lower Log (-1.25) 1.25+-- setLegend True NorthEast Inside+-- withLegendFormat $ setFontSize 6+{-+ withPlot (1,1) $ do + setDataset (ident 300 :: Matrix Double) --ms+ addAxis XAxis (Side Lower) $ setTickLabelFormat "%.0f"+ addAxis YAxis (Side Lower) $ setTickLabelFormat "%.0f"+ setRangeFromData XAxis Lower+ setRangeFromData YAxis Lower+-}++display :: ((Int,Int) -> C.Render ()) -> IO ()+display r = do+ initGUI -- is start++ window <- windowNew+ set window [ windowTitle := "Cairo test window"+ , windowDefaultWidth := 600+ , windowDefaultHeight := 400+ , containerBorderWidth := 1+ ]++-- canvas <- pixbufNew ColorspaceRgb True 8 300 200+-- containerAdd window canvas+ frame <- frameNew+ containerAdd window frame+ canvas <- drawingAreaNew+ containerAdd frame canvas+ widgetModifyBg canvas StateNormal (Color 65535 65535 65535)++ widgetShowAll window ++ on canvas exposeEvent $ tryEvent $ do s <- liftIO $ widgetGetSize canvas+ drw <- liftIO $ widgetGetDrawWindow canvas+ --dat <- liftIO $ takeMVar d+ --liftIO $ renderWithDrawable drw (circle 50 10)+ liftIO $ renderWithDrawable drw (r s)++ onDestroy window mainQuit+ mainGUI++ +main = display $ render figure++test = writeFigure PDF "test.pdf" (400,400) figure
+ examples/Test2.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE UnicodeSyntax #-}++-- thanks to http://www.muitovar.com/gtk2hs/app1.html++--module Test where++import Control.Concurrent+import Control.Concurrent.MVar++import Control.Monad.Trans++import Graphics.UI.Gtk hiding(Circle,Cross)+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++import Data.Colour.Names++import Data.Packed.Vector+--import Data.Packed.Random+import Data.Packed()++--import Prelude.Unicode++import qualified Data.Array.IArray as A++import Numeric.LinearAlgebra++import Numeric.GSL.Statistics++import Graphics.Rendering.Plot++import Debug.Trace++ln = 25+ts = linspace ln (0,1)+rs = ln |> take ln [0.306399512330476,-0.4243863460546792,-0.20454667402138094,-0.42873761654774106,1.3054721019673694,0.6474765138733175,1.1942346875362946,-1.7404737823144103,0.2607101951530985,-0.26782584645524893,-0.31403631431884504,3.365508546473985e-2,0.6147856889630383,-1.191723225061435,-1.9933460981205509,0.6015225906539229,0.6394073044477114,-0.6030919788928317,0.1832742199706381,0.35532918011648473,0.1982646055874545,1.7928383756822786,-9.992760294442601e-2,-1.401166614128362,-1.1088031929569364,-0.827319908453775,1.0406363628775428,-0.3070345979284644,0.6781735212645198,-0.8431706723519456,-0.4245730055085966,-0.6503687925251668,-1.4775567962221399,0.5587634921497298,-0.6481020127107823,7.313441602898768e-2,0.573580543636529,-0.9036472376122673,2.650805059813826,9.329324044673039e-2,1.9133487025468563,-1.5366337588254542,-1.0159359710920388,7.95982933517428e-2,0.5813673663649735,-6.93329631989878e-2,1.1024137719307867,-0.6046286796589855,-0.8812842030098401,1.4612246471009083,0.9584060744500491,9.210899579679932e-2,-0.15850413664405813,-0.4754694827227343,0.8669922262489788,0.4593351854708853,-0.2015350278936992,0.8829710664887649,0.7195048491420026]++ut = linspace 25 (1::Double,100)++ss = sin (15*2*pi*ts)+ds = 0.25*rs + ss+es = constant (0.25*(stddev rs)) ln+gs = 0.40*rs - 1+fs :: Double -> Double+fs = sin . (15*2*pi*)++ms :: Matrix Double+ms = buildMatrix 64 64 (\(x,y) -> sin (2*2*pi*(fromIntegral x)/64) * cos (5*2*pi*(fromIntegral y)/64))++pts = linspace 1000 (0 :: Double,10*pi)+fx = (\t -> t * sin t) pts+fy = (\t -> t * cos t) pts++hx = fromList [1,3,5,8,11,20,22,26,12,10,4] :: Vector Double+hy = fromList [10,11,15,17,14,12,9,11,16,4,6] :: Vector Double+he = fromList [11,13,16,19,16,14,19,7,10,5,3] :: Vector Double++lx = fromList [1,2,3,4,5,6,7,8,9,10] ∷ Vector Double+ly = fromList [50000,10000,5000,1000,500,100,50,10,1] ∷ Vector Double++mx = linspace 100 (1,10) ∷ Vector Double+my = linspace 100 (1,10000) ∷ Vector Double++rx = scaleRecip 1 mx++cx = fromList [1,2,3,4,5] ∷ Vector Double+cyl = fromList [8,10,12,13,8] ∷ Vector Double+cyu = fromList [10,12,16,11,10] ∷ Vector Double+cel = cyl - 1+ceu = cyu + 1++at = linspace 1000 (0,2*pi) ∷ Vector Double+ax = sin at+++figure = do+-- setPlots 1 1+{-+ withPlot (1,1) $ do+ setDataset [(Hist,hx,hy)]+ addAxis XAxis (Side Lower) $ return ()+ addAxis YAxis (Side Lower) $ return ()+-}{- setRange XAxis Lower (-4*pi) (1*pi)+ setRange YAxis Lower (-4*pi) (1*pi) -}+{- setRange XAxis Lower 0 32+ setRange YAxis Lower 0 20+-}+ --withLineDefaults $ setLineWidth 2+ withTextDefaults $ setFontFamily "OpenSymbol"+ withTitle $ setText "Testing plot package:"+{- withSubTitle $ do+ setText "with 1 second of a 15Hz sine wave"+ setFontSize 10+-}+ setPlots 1 1++ withPlot (1,1) $ do+-- setDataset (Bar, lx, [hx,hy,he])+-- barSetting BarStack+-- setDataset (Line, mx, [rx])+-- setDataset (Line, ts, [ds])+ setDataset (ts,[line ds blue])+-- setDataset (ts,[impulse fs blue])+-- setDataset (ts,[point (ds,es,"Sampled data") (Bullet,green)+-- setDataset (ts,[bar (ds,ds+es,"Sampled data") green+-- ,line (fs,"15 Hz sinusoid") blue])+-- setDataset [(Line,fx,fy)]+-- setDataset ([bar (ds,es,"Sampled data") green+-- ,bar (gs,"Modified sample data") blue])+-- setDataset (ts,[bar (ds,"Sampled data") green+-- ,line (fs,"15 Hz sinusoid") blue])+-- setDataset [(Line,mx,my)]+-- setDataset (Whisker,cx,[((cyl,cyu),(cel,ceu))])+-- withAllSeriesFormats (\_ -> do+-- setBarWidth 0.5+-- setBarBorderWidth 0.1)+-- setDataset (Hist,hx,[(hy,he)])+ addAxis XAxis (Side Lower) $ do+ -- setGridlines Major True+ withAxisLabel $ setText "time (s)"+ --setTicks Major (TickValues $ fromList [1,2,5,10])+ setTicks Major (TickNumber 12)+ setTicks Minor (TickNumber 100)+ setTickLabelFormat $ Printf "%.2f"+ --setTickLabels ["Jan","Feb","Mar","Apr","May"]+ --withTickLabelFormat $ setFontSize 8+ addAxis YAxis (Side Lower) $ do+-- setGridlines Major True+ withAxisLabel $ setText "amplitude (α)"+ setTicks Minor (TickNumber 0)+ -- addAxis XAxis (Value 0) $ return ()+-- setRangeFromData XAxis Lower Linear+ setRangeFromData YAxis Lower Linear+-- setRange XAxis Lower Linear 0 11+{- withAnnotations $ do+ arrow True (pi/2,0.5) (0,0) (return ())+ --oval True (0.5,1) (1,3) $ setBarColour blue+ rect True (0.5,0.5) (2,0.75) $ (return ())+ glyph (4,0.2) (return ())+ text (3,0.0) (setText "from the α to the Ω")+ cairo (\_ _ _ _ -> do+ C.moveTo 3 0.75+ C.lineTo 4 (-0.5)+ C.stroke+ )+-}+-- setRange YAxis Lower Log (-1.25) 1.25+-- setLegend True NorthEast Inside+-- withLegendFormat $ setFontSize 6+{-+ withPlot (1,1) $ do + setDataset (ident 300 :: Matrix Double) --ms+ addAxis XAxis (Side Lower) $ setTickLabelFormat "%.0f"+ addAxis YAxis (Side Lower) $ setTickLabelFormat "%.0f"+ setRangeFromData XAxis Lower+ setRangeFromData YAxis Lower+-}++display :: ((Int,Int) -> C.Render ()) -> IO ()+display r = do+ initGUI -- is start++ window <- windowNew+ set window [ windowTitle := "Cairo test window"+ , windowDefaultWidth := 600+ , windowDefaultHeight := 400+ , containerBorderWidth := 1+ ]++-- canvas <- pixbufNew ColorspaceRgb True 8 300 200+-- containerAdd window canvas+ frame <- frameNew+ containerAdd window frame+ canvas <- drawingAreaNew+ containerAdd frame canvas+ widgetModifyBg canvas StateNormal (Color 65535 65535 65535)++ widgetShowAll window ++ on canvas exposeEvent $ tryEvent $ do + s <- liftIO $ widgetGetSize canvas+ drw <- liftIO $ widgetGetDrawWindow canvas+ --dat <- liftIO $ takeMVar d+ --liftIO $ renderWithDrawable drw (circle 50 10)+ liftIO $ renderWithDrawable drw (r s)++ onDestroy window mainQuit+ mainGUI++ +main = display $ render figure++test = writeFigure PDF "test.pdf" (400,400) figure
+ examples/Test3.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE UnicodeSyntax #-}++-- thanks to http://www.muitovar.com/gtk2hs/app1.html++--module Test where++import Control.Concurrent+import Control.Concurrent.MVar++import Control.Monad.Trans++import Graphics.UI.Gtk hiding(Circle,Cross)+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++import Data.Colour.Names++import Data.Packed.Vector+--import Data.Packed.Random+import Data.Packed()++--import Prelude.Unicode++import qualified Data.Array.IArray as A++import Numeric.LinearAlgebra++import Numeric.GSL.Statistics++import Graphics.Rendering.Plot++import Debug.Trace++ln = 25+ts = linspace ln (0,1)+rs = ln |> take ln [0.306399512330476,-0.4243863460546792,-0.20454667402138094,-0.42873761654774106,1.3054721019673694,0.6474765138733175,1.1942346875362946,-1.7404737823144103,0.2607101951530985,-0.26782584645524893,-0.31403631431884504,3.365508546473985e-2,0.6147856889630383,-1.191723225061435,-1.9933460981205509,0.6015225906539229,0.6394073044477114,-0.6030919788928317,0.1832742199706381,0.35532918011648473,0.1982646055874545,1.7928383756822786,-9.992760294442601e-2,-1.401166614128362,-1.1088031929569364,-0.827319908453775,1.0406363628775428,-0.3070345979284644,0.6781735212645198,-0.8431706723519456,-0.4245730055085966,-0.6503687925251668,-1.4775567962221399,0.5587634921497298,-0.6481020127107823,7.313441602898768e-2,0.573580543636529,-0.9036472376122673,2.650805059813826,9.329324044673039e-2,1.9133487025468563,-1.5366337588254542,-1.0159359710920388,7.95982933517428e-2,0.5813673663649735,-6.93329631989878e-2,1.1024137719307867,-0.6046286796589855,-0.8812842030098401,1.4612246471009083,0.9584060744500491,9.210899579679932e-2,-0.15850413664405813,-0.4754694827227343,0.8669922262489788,0.4593351854708853,-0.2015350278936992,0.8829710664887649,0.7195048491420026]++ut = linspace 25 (1::Double,100)++ss = sin (15*2*pi*ts)+ds = 0.25*rs + ss+es = constant (0.25*(stddev rs)) ln+gs = 0.40*rs - 1+fs :: Double -> Double+fs = sin . (15*2*pi*)++ms :: Matrix Double+ms = buildMatrix 64 64 (\(x,y) -> sin (2*2*pi*(fromIntegral x)/64) * cos (5*2*pi*(fromIntegral y)/64))++pts = linspace 1000 (0 :: Double,10*pi)+fx = (\t -> t * sin t) pts+fy = (\t -> t * cos t) pts++hx = fromList [1,3,5,8,11,20,22,26,12,10,4] :: Vector Double+hy = fromList [10,11,15,17,14,12,9,11,16,4,6] :: Vector Double+he = fromList [11,13,16,19,16,14,19,7,10,5,3] :: Vector Double++lx = fromList [1,2,3,4,5,6,7,8,9,10] ∷ Vector Double+ly = fromList [50000,10000,5000,1000,500,100,50,10,1] ∷ Vector Double++mx = linspace 100 (1,10) ∷ Vector Double+my = linspace 100 (1,10000) ∷ Vector Double++rx = scaleRecip 1 mx++cx = fromList [1,2,3,4,5] ∷ Vector Double+cyl = fromList [8,10,12,13,8] ∷ Vector Double+cyu = fromList [10,12,16,11,10] ∷ Vector Double+cel = cyl - 1+ceu = cyu + 1++at = linspace 1000 (0,2*pi) ∷ Vector Double+ax = sin at+++figure = do+ withTextDefaults $ setFontFamily "OpenSymbol"+ withTitle $ setText "Multi-plot test"+-- setBackgroundColour yellow+ setPlots 4 2++ mapM_ (\(x,y) -> withPlot (x,y) $ do+ setDataset (ts,[line ds blue])+-- setPlotBackgroundColour grey+ setPlotPadding 0 0 0 0+ addAxis XAxis (Value 0) $ do+ -- setGridlines Major True+ setTicks Major (TickNumber 5)+ setTicks Minor (TickNumber 41)+ addAxis YAxis (Side Lower) $ do+ setTicks Minor (TickNumber 0)+ setRangeFromData YAxis Lower Linear+ setRangeFromData XAxis Lower Linear) [(x,y)|x <- [1..4],y <- [1..2]]++display :: ((Int,Int) -> C.Render ()) -> IO ()+display r = do+ initGUI -- is start++ window <- windowNew+ set window [ windowTitle := "Cairo test window"+ , windowDefaultWidth := 600+ , windowDefaultHeight := 400+ , containerBorderWidth := 1+ ]++-- canvas <- pixbufNew ColorspaceRgb True 8 300 200+-- containerAdd window canvas+ frame <- frameNew+ containerAdd window frame+ canvas <- drawingAreaNew+ containerAdd frame canvas+ widgetModifyBg canvas StateNormal (Color 65535 65535 65535)++ widgetShowAll window ++ on canvas exposeEvent $ tryEvent $ do + s <- liftIO $ widgetGetSize canvas+ drw <- liftIO $ widgetGetDrawWindow canvas+ --dat <- liftIO $ takeMVar d+ --liftIO $ renderWithDrawable drw (circle 50 10)+ liftIO $ renderWithDrawable drw (r s)++ onDestroy window mainQuit+ mainGUI++ +main = display $ render figure++test = writeFigure PDF "test.pdf" (400,400) figure
lib/Graphics/Rendering/Plot/Figure.hs view
@@ -108,7 +108,7 @@ , setGridlines , setTickLabelFormat , setTickLabels- , withTickLabelFormat+ , withTickLabelsFormat , withAxisLabel , withAxisLine , withGridLine@@ -182,41 +182,42 @@ -- | perform some actions on the text defaults, must be run before other text element modifications withTextDefaults :: Text () -> Figure () withTextDefaults m = do- o <- getDefaults- let to' = _textoptions o- let (FontText to _) = execText m to' (FontText to' "") - modifyDefaults $ \s -> s { _textoptions = to }+ o <- getDefaults+ let to' = _textoptions o+ let (FontText to _) = execText m to' (FontText to' "") + modifyDefaults $ \s -> s { _textoptions = to } -- | perform some actions on the line defaults, must be run before other line element modifications withLineDefaults :: Line () -> Figure () withLineDefaults m = do- o <- getDefaults- let lo' = _lineoptions o- let (TypeLine lo _) = execLine m lo' (TypeLine lo' black)- modifyDefaults $ \s -> s { _lineoptions = lo }+ o <- getDefaults+ let lo' = _lineoptions o+ let (TypeLine lo _) = execLine m lo' (TypeLine lo' black)+ modifyDefaults $ \s -> s { _lineoptions = lo } -- | perform some actions on the point defaults, must be run before other point modifications withPointDefaults :: Point () -> Figure () withPointDefaults m = do- o <- getDefaults- let po' = _pointoptions o- let (FullPoint po _) = execPoint m po' (FullPoint po' defaultGlyph)- modifyDefaults $ \s -> s { _pointoptions = po }+ o <- getDefaults+ let po' = _pointoptions o+ let (FullPoint po _) = execPoint m po' (FullPoint po' defaultGlyph)+ modifyDefaults $ \s -> s { _pointoptions = po } -- | perform some actions on the bar defaults, must be run before other point modifications withBarDefaults :: Bar () -> Figure () withBarDefaults m = do- o <- getDefaults- let bo' = _baroptions o- let (TypeBar bo _) = execBar m bo' (TypeBar bo' black)- modifyDefaults $ \s -> s { _baroptions = bo }+ o <- getDefaults+ let bo' = _baroptions o+ let (TypeBar bo _) = execBar m bo' (TypeBar bo' black)+ modifyDefaults $ \s -> s { _baroptions = bo } ----------------------------------------------------------------------------- -- | create a new blank 'Figure' newFigure :: Figure ()-newFigure = putFigure $ Figure defaultFigureBackgroundColour defaultFigurePadding NoText NoText- (A.listArray ((1,1),(1,1)) [Nothing]) +newFigure = putFigure $ Figure defaultFigureBackgroundColour + defaultFigurePadding NoText NoText+ (A.listArray ((1,1),(1,1)) [Nothing]) {- newLineFigure :: DataSeries -- ^ the y series -> FigureData@@ -244,52 +245,60 @@ -- | set the padding of the figure setFigurePadding :: Double -> Double -> Double -> Double -> Figure ()-setFigurePadding l r b t = modifyFigure $ \s -> s { _fig_pads = Padding l r b t }+setFigurePadding l r b t = modifyFigure $ \s -> + s { _fig_pads = Padding l r b t } -- | operate on the title withTitle :: Text () -> Figure () withTitle m = do- o <- getDefaults- modifyFigure $ \s -> s { _title = execText m (_textoptions o) (_title s) }+ o <- getDefaults+ modifyFigure $ \s -> + s { _title = execText m (_textoptions o) (_title s) } -- | operate on the sub-title withSubTitle :: Text () -> Figure () withSubTitle m = do- o <- getDefaults- modifyFigure $ \s -> s { _subtitle = execText m (_textoptions o) (_title s) }+ o <- getDefaults+ modifyFigure $ \s -> + s { _subtitle = execText m (_textoptions o) (_title s) } -- | set the shape of the plots, losing all current plots setPlots :: Int -- ^ rows -> Int -- ^ columns -> Figure ()-setPlots r c = modifyFigure $ \s -> s { _plots = A.listArray ((1,1),(r,c)) (replicate (r*c) Nothing) }+setPlots r c = modifyFigure $ \s -> + s { _plots = A.listArray ((1,1),(r,c)) + (replicate (r*c) Nothing) } -- | perform some actions on the specified subplot withPlot :: (Int,Int) -> Plot () -> Figure () withPlot i m = do- o <- getDefaults- s <- getSupplies- modifyFigure $ \p -> p { _plots = let plots = _plots p- plot' = plots A.! i- plot = case plot' of- Nothing -> emptyPlot- Just p' -> p'+ o <- getDefaults+ s <- getSupplies+ modifyFigure $ \p -> + p { _plots = let plots = _plots p+ plot' = plots A.! i+ plot = case plot' of+ Nothing -> emptyPlot+ Just p' -> p' -- we revert supplies to the original here -- since we might want the same colour -- order for all plots -- HOWEVER: need a better execPlot group- in plots A.// [(i,Just $ execPlot m s o plot)] }+ in plots A.// [(i,Just $ execPlot m s o plot)] } -- | perform some actions all subplots withPlots :: Plot () -> Figure () withPlots m = do- o <- getDefaults- s <- getSupplies- modifyFigure $ \p -> p { _plots = let plots = _plots p- plot p' = case p' of- Nothing -> emptyPlot- Just p'' -> p''- in plots A.// map (\(i,e) -> (i,Just $ execPlot m s o (plot e))) (A.assocs plots) }+ o <- getDefaults+ s <- getSupplies+ modifyFigure $ \p -> + p { _plots = let plots = _plots p+ plot p' = case p' of+ Nothing -> emptyPlot+ Just p'' -> p''+ in plots A.// map (\(i,e) -> + (i,Just $ execPlot m s o (plot e))) (A.assocs plots) } -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Figure/Plot.hs view
@@ -74,7 +74,7 @@ , AX.setGridlines , AX.setTickLabelFormat , AX.setTickLabels- , AX.withTickLabelFormat+ , AX.withTickLabelsFormat , AX.withAxisLabel , AX.withAxisLine , AX.withGridLine@@ -173,24 +173,27 @@ -- | clear an axis of a subplot clearAxis :: AxisType -> AxisPosn -> Plot () clearAxis at axp = do- ax <- gets _axes- modify $ \s -> s { _axes = filter (\(Axis at' axp' _ _ _ _ _ _) -> not (at == at' && axp == axp')) ax } + ax <- gets _axes+ modify $ \s -> s { _axes = + filter (\(Axis at' axp' _ _ _ _ _ _) -> not (at == at' && axp == axp')) ax } -- | add an axis to the subplot addAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot () addAxis at axp m = do- ax' <- gets _axes- o <- ask- let ax = execAxis m o (defaultAxis at axp)- modify $ \s -> s { _axes = ax : ax' }+ ax' <- gets _axes+ o <- ask+ let ax = execAxis m o (defaultAxis at axp)+ modify $ \s -> s { _axes = ax : ax' } -- | operate on the given axis withAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot () withAxis at axp m = do- axes' <- gets _axes- o <- ask- modify $ \s -> s { _axes = map (\a@(Axis at' ap' _ _ _ _ _ _) - -> if at == at' && axp == ap' then execAxis m o a else a) axes' }+ axes' <- gets _axes+ o <- ask+ modify $ \s -> s { _axes = + map (\a@(Axis at' ap' _ _ _ _ _ _) -> if at == at' && axp == ap' + then execAxis m o a + else a) axes' } ----------------------------------------------------------------------------- @@ -204,7 +207,7 @@ clearLegend = withLegend $ L.clearLegend -- | set the legend location and orientation-setLegend :: L.LegendBorder -> L.LegendLocation -> L.LegendOrientation -> Plot()+setLegend :: L.LegendBorder -> L.LegendLocation -> L.LegendOrientation -> Plot () setLegend b l o = withLegend $ L.setLegend b l o -- | format the legend text@@ -277,19 +280,22 @@ ----------------------------------------------------------------------------- findMinMax :: Abscissae -> Ordinates -> (Double,Double)-findMinMax (AbsFunction _) (OrdFunction _ f _) = let v = mapVector f (linspace 100 (-1,1))- in (minElement v,maxElement v)-findMinMax (AbsPoints _ x) (OrdFunction _ f _) = let v = mapVector f x- in (minElement v,maxElement v)- -- what if errors go beyond plot?+findMinMax (AbsFunction _) (OrdFunction _ f _) = + let v = mapVector f (linspace 100 (-1,1))+ in (minElement v,maxElement v)+findMinMax (AbsPoints _ x) (OrdFunction _ f _) = + let v = mapVector f x+ in (minElement v,maxElement v)+-- what if errors go beyond plot? findMinMax _ (OrdPoints _ (Plain o) _) = (minElement o,maxElement o) findMinMax _ (OrdPoints _ (Error o _) _) = (minElement o,maxElement o)-findMinMax _ (OrdPoints _ (MinMax (o,p) _) _) = (Prelude.min (minElement o) (minElement p)- ,Prelude.max (maxElement o) (maxElement p))+findMinMax _ (OrdPoints _ (MinMax (o,p) _) _) = + (Prelude.min (minElement o) (minElement p)+ ,Prelude.max (maxElement o) (maxElement p)) abscMinMax :: Abscissae -> (Double,Double)-abscMinMax (AbsFunction _) = defaultXAxisSideLowerRange-abscMinMax (AbsPoints _ x) = (minElement x,maxElement x)+abscMinMax (AbsFunction _) = defaultXAxisSideLowerRange+abscMinMax (AbsPoints _ x) = (minElement x,maxElement x) ordDim :: Ordinates -> Int@@ -298,21 +304,27 @@ calculateRanges :: DataSeries -> ((Double,Double),(Double,Double))-calculateRanges (DS_Y ys) = let xmax = maximum $ map (\(DecSeries o _) -> fromIntegral $ ordDim o) $ A.elems ys- ym = unzip $ map (\(DecSeries o _) -> findMinMax (AbsFunction id) o) $ A.elems ys- ymm = (minimum $ fst ym,maximum $ snd ym)- in ((0,xmax),ymm)-calculateRanges (DS_1toN x ys) = let ym = unzip $ map (\(DecSeries o _) -> findMinMax x o) $ A.elems ys- ymm = (minimum $ fst ym,maximum $ snd ym)- xmm = abscMinMax x- in (xmm,ymm)-calculateRanges (DS_1to1 ys) = let (xm',ym') = unzip $ A.elems ys- ym = unzip $ map (\(x,(DecSeries o _)) -> findMinMax x o) (zip xm' ym')- ymm = (minimum $ fst ym,maximum $ snd ym)- xm = unzip $ map abscMinMax xm'- xmm = (minimum $ fst xm,maximum $ snd xm) - in (xmm,ymm)-calculateRanges (DS_Surf m) = ((0,fromIntegral $ cols m),(fromIntegral $ rows m,0))+calculateRanges (DS_Y ys) = + let xmax = maximum $ map (\(DecSeries o _) -> + fromIntegral $ ordDim o) $ A.elems ys+ ym = unzip $ map (\(DecSeries o _) -> + findMinMax (AbsFunction id) o) $ A.elems ys+ ymm = (minimum $ fst ym,maximum $ snd ym)+ in ((0,xmax),ymm)+calculateRanges (DS_1toN x ys) = + let ym = unzip $ map (\(DecSeries o _) -> findMinMax x o) $ A.elems ys+ ymm = (minimum $ fst ym,maximum $ snd ym)+ xmm = abscMinMax x+ in (xmm,ymm)+calculateRanges (DS_1to1 ys) = + let (xm',ym') = unzip $ A.elems ys+ ym = unzip $ map (\(x,(DecSeries o _)) -> findMinMax x o) (zip xm' ym')+ ymm = (minimum $ fst ym,maximum $ snd ym)+ xm = unzip $ map abscMinMax xm'+ xmm = (minimum $ fst xm,maximum $ snd xm) + in (xmm,ymm)+calculateRanges (DS_Surf m) = + ((0,fromIntegral $ cols m),(fromIntegral $ rows m,0)) -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs view
@@ -21,7 +21,7 @@ , setGridlines , setTickLabelFormat , setTickLabels- , withTickLabelFormat+ , withTickLabelsFormat , withAxisLabel , withAxisLine , withGridLine@@ -62,28 +62,28 @@ -- | format the axis line withAxisLine :: Line () -> Axis () withAxisLine m = do- l <- gets _line_type- lo <- asks _lineoptions- let lt = execLine m lo l- modify $ \s -> s { _line_type = lt }+ l <- gets _line_type+ lo <- asks _lineoptions+ let lt = execLine m lo l+ modify $ \s -> s { _line_type = lt } -- | format the grid lines withGridLine :: Tick -> Line () -> Axis () withGridLine t m = do- lo <- asks _lineoptions- (lt',v) <- case t of- Minor -> do- -- at this point can we guarantee there won't- -- be a Nothing?- (Just (Ticks lt'' v')) <- gets _minor_ticks- return (lt'',v')- Major -> do- (Just (Ticks lt'' v')) <- gets _major_ticks- return (lt'',v')- let lt = execLine m lo lt'- case t of- Minor -> modify $ \s -> s { _minor_ticks = (Just (Ticks lt v)) }- Major -> modify $ \s -> s { _major_ticks = (Just (Ticks lt v)) }+ lo <- asks _lineoptions+ (lt',v) <- case t of+ Minor -> do+ -- at this point can we guarantee there won't+ -- be a Nothing?+ (Just (Ticks lt'' v')) <- gets _minor_ticks+ return (lt'',v')+ Major -> do+ (Just (Ticks lt'' v')) <- gets _major_ticks+ return (lt'',v')+ let lt = execLine m lo lt'+ case t of+ Minor -> modify $ \s -> s { _minor_ticks = (Just (Ticks lt v)) }+ Major -> modify $ \s -> s { _major_ticks = (Just (Ticks lt v)) } -- | format the axis ticks setTicks :: Tick -> TickValues -> Axis ()@@ -98,8 +98,10 @@ -- | should gridlines be displayed? setGridlines :: Tick -> GridLines -> Axis ()-setGridlines Minor gl = modify $ \s -> changeMinorTicks (setTickGridlines (if gl then defaultGridLine else NoLine)) s-setGridlines Major gl = modify $ \s -> changeMajorTicks (setTickGridlines (if gl then defaultGridLine else NoLine)) s+setGridlines Minor gl = modify $ \s -> + changeMinorTicks (setTickGridlines (if gl then defaultGridLine else NoLine)) s+setGridlines Major gl = modify $ \s -> + changeMajorTicks (setTickGridlines (if gl then defaultGridLine else NoLine)) s -- | set the tick label format setTickLabelFormat :: TickFormat -> Axis ()@@ -110,9 +112,9 @@ setTickLabels dl = modify $ \s -> changeTickLabels (const (map BareText dl)) s --- | format the data labels-withTickLabelFormat :: Text () -> Axis ()-withTickLabelFormat m = do+-- | format the tick labels+withTickLabelsFormat :: Text () -> Axis ()+withTickLabelsFormat m = do ax <- get to <- asks _textoptions put $ ax { _tick_labels = map (execText m to) (_tick_labels ax) }@@ -120,9 +122,19 @@ -- | operate on the axis label withAxisLabel :: Text () -> Axis () withAxisLabel m = do- ax <- get- to <- asks _textoptions- put $ ax { _label = execText m to (_label ax) } + ax <- get+ to <- asks _textoptions+ put $ ax { _label = execText m to (_label ax) } ++-----------------------------------------------------------------------------++-- | format the tick labels+{- DEPRECATED "use `withTickLabelsFormat`" -}+withTickLabelFormat :: Text () -> Axis ()+withTickLabelFormat m = do+ ax <- get+ to <- asks _textoptions+ put $ ax { _tick_labels = map (execText m to) (_tick_labels ax) } -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Render.hs view
@@ -77,21 +77,25 @@ -> (Int,Int) -- ^ (width,height) -> C.Render () -- ^ a Cairo operation render g = (\(w,h) -> do- pc <- pango $ P.cairoCreateContext Nothing- to <- pango $ getDefaultTextOptions pc- let options' = Options defaultLineOptions defaultPointOptions defaultBarOptions to- let (FigureState options _ figure) = execFigure g (FigureState options' defaultSupply emptyFigure)- evalRender (renderFigure figure) (RenderEnv pc options) (BoundingBox 0 0 (fromIntegral w) (fromIntegral h)))+ pc <- pango $ P.cairoCreateContext Nothing+ to <- pango $ getDefaultTextOptions pc+ let options' = Options defaultLineOptions + defaultPointOptions defaultBarOptions to+ let (FigureState options _ figure) = + execFigure g (FigureState options' defaultSupply emptyFigure)+ evalRender (renderFigure figure) (RenderEnv pc options) + (BoundingBox 0 0 (fromIntegral w) (fromIntegral h))) ----------------------------------------------------------------------------- -- | create 'FigureState' from a series of 'Figure' actions newFigureState :: Figure () -> IO FigureState newFigureState f = do- pc <- P.cairoCreateContext Nothing- to <- getDefaultTextOptions pc- let options' = Options defaultLineOptions defaultPointOptions defaultBarOptions to- return $ execFigure f (FigureState options' defaultSupply emptyFigure)+ pc <- P.cairoCreateContext Nothing+ to <- getDefaultTextOptions pc+ let options' = Options defaultLineOptions + defaultPointOptions defaultBarOptions to+ return $ execFigure f (FigureState options' defaultSupply emptyFigure) -- | modify a 'FigureState' with some new actions updateFigureState :: FigureState -> Figure () -> FigureState@@ -102,8 +106,9 @@ -> (Int,Int) -- ^ (width,height) -> C.Render () -- ^ a Cairo operation renderFigureState (FigureState options _ figure) = (\(w,h) -> do- pc <- pango $ P.cairoCreateContext Nothing- evalRender (renderFigure figure) (RenderEnv pc options) (BoundingBox 0 0 (fromIntegral w) (fromIntegral h))) + pc <- pango $ P.cairoCreateContext Nothing+ evalRender (renderFigure figure) (RenderEnv pc options) + (BoundingBox 0 0 (fromIntegral w) (fromIntegral h))) ----------------------------------------------------------------------------- @@ -123,12 +128,13 @@ writeSurfaceToPNG :: FilePath -> C.Render () -> C.Surface -> IO () writeSurfaceToPNG fn r s = do- C.renderWith s r- C.surfaceWriteToPNG s fn+ C.renderWith s r+ C.surfaceWriteToPNG s fn writeSurface :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) -> FilePath -> (Int,Int) -> Figure () -> IO ()-writeSurface rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) (flip C.renderWith (render f (w,h))) +writeSurface rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) + (flip C.renderWith (render f (w,h))) ----------------------------------------------------------------------------- @@ -138,36 +144,39 @@ -> (Int,Int) -- ^ (width,height) -> FigureState -- ^ a FigureState -> IO ()-writeFigureState PNG fn wh f = withImageSurface wh (writeSurfaceToPNG fn (renderFigureState f wh))+writeFigureState PNG fn wh f = withImageSurface wh + (writeSurfaceToPNG fn (renderFigureState f wh)) writeFigureState PS fn wh f = writeSurfaceFS C.withPSSurface fn wh f writeFigureState PDF fn wh f = writeSurfaceFS C.withPDFSurface fn wh f writeFigureState SVG fn wh f = writeSurfaceFS C.withSVGSurface fn wh f writeSurfaceFS :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) -> FilePath -> (Int,Int) -> FigureState -> IO ()-writeSurfaceFS rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) (flip C.renderWith (renderFigureState f (w,h))) +writeSurfaceFS rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) + (flip C.renderWith (renderFigureState f (w,h))) ----------------------------------------------------------------------------- renderFigure :: FigureData -> Render () renderFigure (Figure b p t s d) = do- cairo $ do- C.save - setColour b- C.paint- C.restore+ cairo $ do+ C.save + setColour b+ C.paint+ C.restore - applyPads p+ applyPads p - tx <- bbCentreWidth- ty <- bbTopHeight- (_,th) <- renderText t Centre TTop tx ty- bbLowerTop (th+textPad)+ tx <- bbCentreWidth+ ty <- bbTopHeight+ (_,th) <- renderText t Centre TTop tx ty+ bbLowerTop (th+textPad) - sx <- bbCentreWidth- sy <- bbTopHeight- (_,sh) <- renderText s Centre TTop sx sy- bbLowerTop (sh+textPad)+ sx <- bbCentreWidth+ sy <- bbTopHeight+ (_,sh) <- renderText s Centre TTop sx sy+ bbLowerTop (sh+textPad) - renderPlots d+ renderPlots d +-----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Render/Plot.hs view
@@ -103,8 +103,13 @@ renderData r bc d renderAnnotations r an cairo C.restore+ cairo C.save legend padding+ cairo C.restore+ cairo C.save axes+ cairo C.restore+ renderBorder :: Border -> Render () renderBorder False = return () renderBorder True = do
lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs view
@@ -176,28 +176,36 @@ shiftForTicks :: Ranges -> Padding -> AxisData -> Render Padding shiftForTicks (Ranges (Left (Range _ xmin xmax)) _) p (Axis XAxis (Side Lower) _ min maj tf dl _) - = shiftForTicks' p min maj XAxis (Side Lower) tf dl (negate $ Prelude.max (abs xmin) (abs xmax))+ = shiftForTicks' p min maj XAxis (Side Lower) tf dl + (negate $ Prelude.max (abs xmin) (abs xmax)) shiftForTicks (Ranges (Left (Range _ xmin xmax)) _) p (Axis XAxis (Side Upper) _ min maj tf dl _) - = shiftForTicks' p min maj XAxis (Side Upper) tf dl (negate $ Prelude.max (abs xmin) (abs xmax))+ = shiftForTicks' p min maj XAxis (Side Upper) tf dl + (negate $ Prelude.max (abs xmin) (abs xmax)) shiftForTicks (Ranges (Right ((Range _ xmin xmax),_)) _) p (Axis XAxis (Side Lower) _ min maj tf dl _) - = shiftForTicks' p min maj XAxis (Side Lower) tf dl (negate $ Prelude.max (abs xmin) (abs xmax))+ = shiftForTicks' p min maj XAxis (Side Lower) tf dl + (negate $ Prelude.max (abs xmin) (abs xmax)) shiftForTicks (Ranges (Right (_,(Range _ xmin xmax))) _) p (Axis XAxis (Side Upper) _ min maj tf dl _) - = shiftForTicks' p min maj XAxis (Side Upper) tf dl (negate $ Prelude.max (abs xmin) (abs xmax))+ = shiftForTicks' p min maj XAxis (Side Upper) tf dl + (negate $ Prelude.max (abs xmin) (abs xmax)) shiftForTicks (Ranges _ (Left (Range _ ymin ymax))) p (Axis YAxis (Side Lower) _ min maj tf dl _) - = shiftForTicks' p min maj YAxis (Side Lower) tf dl (negate $ Prelude.max (abs ymin) (abs ymax))+ = shiftForTicks' p min maj YAxis (Side Lower) tf dl + (negate $ Prelude.max (abs ymin) (abs ymax)) shiftForTicks (Ranges _ (Left (Range _ ymin ymax))) p (Axis YAxis (Side Upper) _ min maj tf dl _) - = shiftForTicks' p min maj YAxis (Side Upper) tf dl (negate $ Prelude.max (abs ymin) (abs ymax))+ = shiftForTicks' p min maj YAxis (Side Upper) tf dl + (negate $ Prelude.max (abs ymin) (abs ymax)) shiftForTicks (Ranges _ (Right ((Range _ ymin ymax),_))) p (Axis YAxis (Side Lower) _ min maj tf dl _) - = shiftForTicks' p min maj YAxis (Side Lower) tf dl (negate $ Prelude.max (abs ymin) (abs ymax))+ = shiftForTicks' p min maj YAxis (Side Lower) tf dl + (negate $ Prelude.max (abs ymin) (abs ymax)) shiftForTicks (Ranges _ (Right (_,(Range _ ymin ymax)))) p (Axis YAxis (Side Upper) _ min maj tf dl _) - = shiftForTicks' p min maj YAxis (Side Upper) tf dl (negate $ Prelude.max (abs ymin) (abs ymax))+ = shiftForTicks' p min maj YAxis (Side Upper) tf dl + (negate $ Prelude.max (abs ymin) (abs ymax)) shiftForTicks _ p (Axis _ (Value _) _ _ _ _ _ _) = return p @@ -210,10 +218,10 @@ (tw,th) <- cairo $ do let s = formatTick tf v s' = if null dl then s else case head dl of- NoText -> error "NoText as a datalabel"- BareText bt -> bt- SizeText _ _ st -> st - FontText _ ft -> ft+ NoText -> error "NoText as a datalabel"+ BareText bt -> bt+ SizeText _ _ st -> st + FontText _ ft -> ft lt <- pango $ P.layoutText pc s' setTextOptions (scaleFontSize tickLabelScale to) lt (_,twh) <- textSize lt Centre Middle 0 0@@ -319,7 +327,7 @@ C.stroke tickPosition :: Tick -> Scale -> Double -> Double -> Either Int [Double] -> [(Double,Double)]-tickPosition tk sc min max nv = +tickPosition _ sc min max nv = let ticks = either (\n -> take n [(0::Double)..]) id nv l = fromIntegral $ length ticks - 1 pos = case nv of@@ -372,49 +380,64 @@ let sd' = case sd of (Side _) -> sd (Value v) -> case ax of- XAxis -> let (Range _ b t) = lowerRange yrange+ XAxis -> let (Range _ b t) = + lowerRange yrange in Value (y+h*(t-v)/(t-b))- YAxis -> let (Range _ b t) = lowerRange xrange+ YAxis -> let (Range _ b t) = + lowerRange xrange in Value (x+w*(v-b)/(t-b))- - let renderAxisTick' = renderAxisTick pc to x y w h sc min max ax sd' tf + let renderAxisTick' = renderAxisTick pc to x y w h + sc min max ax sd' tf (majpos',gmaj',tjpos,tmaj') <- case tmj of (Just (Ticks gmaj (TickNumber tmaj))) -> do- let (pos,val) = unzip (tickPosition Major sc min max (Left tmaj)) + let (pos,val) = unzip (tickPosition Major sc min max + (Left tmaj)) let ln = length pos- let dl' = if null dl then replicate ln Nothing else map Just dl+ let dl' = if null dl + then replicate ln Nothing + else map Just dl let majpos = let ones = 1.0 : ones in zip4 pos (take ln ones) val dl' return $ (Just majpos,Just gmaj,Just pos,Just tmaj) (Just (Ticks gmaj (TickValues tmaj))) -> do- let (pos,val) = unzip (tickPosition Major sc min max (Right $ toList tmaj))+ let (pos,val) = unzip (tickPosition Major sc min max + (Right $ toList tmaj)) ln = length pos- let dl' = if null dl then replicate ln Nothing else map Just dl+ let dl' = if null dl + then replicate ln Nothing + else map Just dl let majpos = let ones = 1.0 : ones in zip4 pos (take ln ones) val dl' return $ (Just majpos,Just gmaj,Just pos,Nothing) Nothing -> return (Nothing,Nothing,Nothing,Nothing) (minpos',gmin') <- case tmn of (Just (Ticks gmin (TickNumber tmin))) -> do- let (pos',val') = unzip (tickPosition Minor sc min max (Left tmin))+ let (pos',val') = unzip (tickPosition Minor sc min max + (Left tmin)) ln' = length pos'- minpos' = zip4 pos' (minorTickLengths tmin (maybe 0 id tmaj')) val' - (replicate ln' Nothing)- minpos = filter (not . (\(p,_,_,_) -> elem p (maybe [] id tjpos))) minpos'+ minpos' = zip4 pos' (minorTickLengths tmin + (maybe 0 id tmaj')) val' + (replicate ln' Nothing)+ minpos = filter (not . (\(p,_,_,_) -> + elem p (maybe [] id tjpos))) minpos' return $ (Just minpos,Just gmin) (Just (Ticks gmin (TickValues tmin))) -> do- let (pos,val) = unzip (tickPosition Minor sc min max (Right $ toList tmin))+ let (pos,val) = unzip (tickPosition Minor sc min max + (Right $ toList tmin)) ln = length pos minpos' = let halves = 0.7 : halves in zip4 pos halves pos (replicate ln Nothing)- minpos = filter (not . (\(p,_,_,_) -> elem p (maybe [] id tjpos))) minpos'+ minpos = filter (not . (\(p,_,_,_) -> + elem p (maybe [] id tjpos))) minpos' return $ (Just minpos,Just gmin) Nothing -> return (Nothing,Nothing) case majpos' of- (Just m) -> mapM_ (renderAxisTick' Major (maybe NoLine id gmaj')) m+ (Just m) -> mapM_ (renderAxisTick' Major + (maybe NoLine id gmaj')) m Nothing -> return () case minpos' of- (Just m) -> mapM_ (renderAxisTick' Minor (maybe NoLine id gmin')) m+ (Just m) -> mapM_ (renderAxisTick' Minor + (maybe NoLine id gmin')) m Nothing -> return () return () return ()
lib/Graphics/Rendering/Plot/Render/Plot/Data.hs view
@@ -199,19 +199,20 @@ shiftAbscissa :: (Integer,(Abscissae,DecoratedSeries,BarType)) -> Double -> (Integer,(Abscissae,DecoratedSeries))-shiftAbscissa (i,(AbsFunction f,ds,_)) s = (i,(AbsFunction ((+) s . f),ds))-shiftAbscissa (i,(AbsPoints mi t,ds,_)) s = (i,(AbsPoints mi (addConstant s t),ds))+shiftAbscissa (j,(AbsFunction f,ds,_)) s = (j,(AbsFunction ((+) s . f),ds))+shiftAbscissa (j,(AbsPoints mi t,ds,_)) s = (j,(AbsPoints mi (addConstant s t),ds)) replaceBars :: [(Integer,(Abscissae,DecoratedSeries))] -> [(Abscissae,DecoratedSeries)] -> [(Abscissae,DecoratedSeries)] replaceBars [] as = as-replaceBars ((i,ds):dss) as = replaceBars dss $ replace i ds as+replaceBars ((j,ds):dss) as = replaceBars dss $ replace j ds as scanStacked :: Vector Double -> (Integer,(Abscissae,DecoratedSeries,BarType)) -> Vector Double-scanStacked v (i,(_,DecSeries (OrdPoints _ o _) _,_)) = v + (getOrdData o)+scanStacked v (_,(_,DecSeries (OrdPoints _ o _) _,_)) = v + (getOrdData o)+scanStacked _ _ = error "Data.hs:scanStacked: unreachable code" convertBarToCandle :: (Vector Double,Vector Double) -> OrdSeries@@ -225,20 +226,22 @@ mkCandlesFromBars :: (Vector Double,Vector Double) -> (Integer,(Abscissae,DecoratedSeries,BarType)) -> (Integer,(Abscissae,DecoratedSeries))-mkCandlesFromBars (v,w) (i,(a,DecSeries (OrdPoints ax o mb_l) _,bt)) = - (i,(a,DecSeries (OrdPoints ax ordSeries mb_l) (DecCand bt)))+mkCandlesFromBars (v,w) (j,(a,DecSeries (OrdPoints ax o mb_l) _,bt)) = + (j,(a,DecSeries (OrdPoints ax ordSeries mb_l) (DecCand bt))) where ordSeries = convertBarToCandle (v,w) o+mkCandlesFromBars _ _ = error "Data.hs:mkCandlesFromBars: unreachable code" getOrdData' :: DecoratedSeries -> Series getOrdData' (DecSeries (OrdPoints _ os _) _) = getOrdData os+getOrdData' _ = error "Data.hs:getOrdData': unreachable code" configureBars :: Scale -> Scale -> Double -> Double -> Double -> Double -> BarSetting -> [(Abscissae,DecoratedSeries)] -> Render [(Abscissae,DecoratedSeries)] -configureBars xsc ysc xmin xmax xscale yscale bs aos = do+configureBars _ _ _ _ xscale _ bs aos = do let bars = mapMaybe getBar $ zip [0..] aos case bs of BarNone -> return aos@@ -259,6 +262,7 @@ let aos' = replaceBars candles aos return aos' where pair [] = []+ pair [_] = error "Data.hs:configureBars:pair: unreachable code" pair [x,y] = [(x,y)] pair (x:y:xs) = (x,y) : pair (y:xs)
lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs view
@@ -184,6 +184,7 @@ (textPad + legendSampleWidth + legendSampleWidth + textPad + w + textPad) 0 0 h to ls return ()+renderLegendOutside _ _ _ _ _ _ _ = return (\_ -> return ()) renderBorder :: Double -> Color -> Double -> Double -> Double -> Double -> C.Render () renderBorder lw c x y w h = do@@ -279,9 +280,11 @@ Nothing -> return () Just p' -> do cairo $ do- g <- setPointStyle p'+ C.save C.moveTo (x+w/2) (y+h/2)+ g <- setPointStyle p' renderGlyph 1 g+ C.restore -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Render/Types.hs view
@@ -96,22 +96,27 @@ bbTopHeight = gets $ \(BoundingBox _ y _ _) -> y bbShiftLeft, bbShiftRight, bbLowerTop, bbRaiseBottom :: Double -> Render ()-bbShiftLeft n = modify $ \(BoundingBox x y w h) -> BoundingBox (x+n) y (w-n) h-bbShiftRight n = modify $ \(BoundingBox x y w h) -> BoundingBox x y (w-n) h-bbLowerTop n = modify $ \(BoundingBox x y w h) -> BoundingBox x (y+n) w (h-n)-bbRaiseBottom n = modify $ \(BoundingBox x y w h) -> BoundingBox x y w (h-n)+bbShiftLeft n = modify $ \(BoundingBox x y w h) -> + BoundingBox (x+n) y (w-n) h+bbShiftRight n = modify $ \(BoundingBox x y w h) -> + BoundingBox x y (w-n) h+bbLowerTop n = modify $ \(BoundingBox x y w h) -> + BoundingBox x (y+n) w (h-n)+bbRaiseBottom n = modify $ \(BoundingBox x y w h) -> + BoundingBox x y w (h-n) applyPads :: Padding -> Render ()-applyPads (Padding l r b t) = modify (\(BoundingBox x y w h) -> BoundingBox (x+l) (y+t) (w-l-r) (h-t-b))+applyPads (Padding l r b t) = modify (\(BoundingBox x y w h) -> + BoundingBox (x+l) (y+t) (w-l-r) (h-t-b)) ----------------------------------------------------------------------------- clipBoundary :: Render () clipBoundary = do- (BoundingBox x y w h) <- get- cairo $ do- C.rectangle x y w h- C.clip+ (BoundingBox x y w h) <- get+ cairo $ do+ C.rectangle x y w h+ C.clip ----------------------------------------------------------------------------- @@ -128,51 +133,51 @@ setDashes :: [Dash] -> C.Render () setDashes [] = C.setDash [] 0 setDashes xs = do- let xs' = map (\d -> case d of { Dot -> 1 ; Dash -> 3 }) xs- C.setDash xs' 0+ let xs' = map (\d -> case d of { Dot -> 1 ; Dash -> 3 }) xs+ C.setDash xs' 0 ----------------------------------------------------------------------------- getDefaultTextOptions :: P.PangoContext -> IO TextOptions getDefaultTextOptions pc = do- fd <- P.contextGetFontDescription pc- getTextOptionsFD fd+ fd <- P.contextGetFontDescription pc+ getTextOptionsFD fd getTextOptionsFD :: P.FontDescription -> IO TextOptions getTextOptionsFD fd = do- ff' <- P.fontDescriptionGetFamily fd- fs' <- P.fontDescriptionGetStyle fd- fv' <- P.fontDescriptionGetVariant fd- fw' <- P.fontDescriptionGetWeight fd- fc' <- P.fontDescriptionGetStretch fd- fz' <- P.fontDescriptionGetSize fd- let ff = fromMaybe defaultFontFamily ff'- fs = fromMaybe defaultFontStyle fs'- fv = fromMaybe defaultFontVariant fv'- fw = fromMaybe defaultFontWeight fw'- fc = fromMaybe defaultFontStretch fc'- fz = fromMaybe defaultFontSize fz'- return $ TextOptions (FontOptions ff fs fv fw fc) fz black+ ff' <- P.fontDescriptionGetFamily fd+ fs' <- P.fontDescriptionGetStyle fd+ fv' <- P.fontDescriptionGetVariant fd+ fw' <- P.fontDescriptionGetWeight fd+ fc' <- P.fontDescriptionGetStretch fd+ fz' <- P.fontDescriptionGetSize fd+ let ff = fromMaybe defaultFontFamily ff'+ fs = fromMaybe defaultFontStyle fs'+ fv = fromMaybe defaultFontVariant fv'+ fw = fromMaybe defaultFontWeight fw'+ fc = fromMaybe defaultFontStretch fc'+ fz = fromMaybe defaultFontSize fz'+ return $ TextOptions (FontOptions ff fs fv fw fc) fz black setTextOptions :: TextOptions -> P.PangoLayout -> C.Render () setTextOptions to lo = do- fd' <- pango $ P.layoutGetFontDescription lo- fd <- case fd' of- Nothing -> pango $ P.fontDescriptionNew- Just fd'' -> return fd''- setTextOptionsFD to fd- pango $ P.layoutSetFontDescription lo (Just fd)+ fd' <- pango $ P.layoutGetFontDescription lo+ fd <- case fd' of+ Nothing -> pango $ P.fontDescriptionNew+ Just fd'' -> return fd''+ setTextOptionsFD to fd+ pango $ P.layoutSetFontDescription lo (Just fd) setTextOptionsFD :: TextOptions -> P.FontDescription -> C.Render () setTextOptionsFD (TextOptions (FontOptions ff fs fv fw fc) fz c) fd = do- pango $ do- P.fontDescriptionSetFamily fd ff- P.fontDescriptionSetStyle fd fs- P.fontDescriptionSetVariant fd fv- P.fontDescriptionSetWeight fd fw- P.fontDescriptionSetStretch fd fc- P.fontDescriptionSetSize fd fz- setColour c+ pango $ do+ P.fontDescriptionSetFamily fd ff+ P.fontDescriptionSetStyle fd fs+ P.fontDescriptionSetVariant fd fv+ P.fontDescriptionSetWeight fd fw+ P.fontDescriptionSetStretch fd fc+ P.fontDescriptionSetSize fd fz+ setColour c ----------------------------------------------------------------------------- @@ -186,27 +191,27 @@ setLineOptions :: LineOptions -> C.Render () setLineOptions (LineOptions ds lw) = do- setDashes ds- C.setLineWidth lw+ setDashes ds+ C.setLineWidth lw setLineStyle :: LineType -> C.Render () setLineStyle NoLine = return () setLineStyle (ColourLine c) = setColour c setLineStyle (TypeLine lo c) = do- setLineOptions lo- setColour c+ setLineOptions lo+ setColour c ----------------------------------------------------------------------------- setPointOptions :: PointOptions -> C.Render () setPointOptions (PointOptions pz c) = do- setColour c- C.scale pz pz+ setColour c+ C.scale pz pz setPointStyle :: PointType -> C.Render Glyph setPointStyle (FullPoint po g) = do- setPointOptions po- return g+ setPointOptions po+ return g -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Types.hs view
@@ -157,19 +157,29 @@ data Scale = Linear | Log deriving(Eq) -data Range = Range { _range_scale :: Scale, _range_min :: Double, _range_max :: Double }+data Range = Range { _range_scale :: Scale, + _range_min :: Double, + _range_max :: Double } data Ranges = Ranges (Either Range (Range,Range)) (Either Range (Range,Range)) getRanges :: AxisType -> AxisSide -> Ranges -> (Scale,Double,Double)-getRanges XAxis Lower (Ranges (Left (Range scale xmin xmax)) _) = (scale,xmin,xmax)-getRanges XAxis Lower (Ranges (Right (Range scale xmin xmax,_)) _) = (scale,xmin,xmax)-getRanges XAxis Upper (Ranges (Right (_,Range scale xmin xmax)) _) = (scale,xmin,xmax)-getRanges XAxis Upper (Ranges (Left _) _) = error "no upper range defined"-getRanges YAxis Lower (Ranges _ (Left (Range scale ymin ymax))) = (scale,ymin,ymax)-getRanges YAxis Lower (Ranges _ (Right (Range scale ymin ymax,_))) = (scale,ymin,ymax)-getRanges YAxis Upper (Ranges _ (Right (_,Range scale ymin ymax))) = (scale,ymin,ymax)-getRanges YAxis Upper (Ranges _ (Left _)) = error "no upper range defined"+getRanges XAxis Lower (Ranges (Left (Range scale xmin xmax)) _) = + (scale,xmin,xmax)+getRanges XAxis Lower (Ranges (Right (Range scale xmin xmax,_)) _) = + (scale,xmin,xmax)+getRanges XAxis Upper (Ranges (Right (_,Range scale xmin xmax)) _) = + (scale,xmin,xmax)+getRanges XAxis Upper (Ranges (Left _) _) = + error "no upper range defined"+getRanges YAxis Lower (Ranges _ (Left (Range scale ymin ymax))) = + (scale,ymin,ymax)+getRanges YAxis Lower (Ranges _ (Right (Range scale ymin ymax,_))) = + (scale,ymin,ymax)+getRanges YAxis Upper (Ranges _ (Right (_,Range scale ymin ymax))) = + (scale,ymin,ymax)+getRanges YAxis Upper (Ranges _ (Left _)) = + error "no upper range defined" -----------------------------------------------------------------------------
plot.cabal view
@@ -1,12 +1,12 @@ Name: plot-Version: 0.2.1+Version: 0.2.2 License: BSD3 License-file: LICENSE-Copyright: (c) A.V.H. McPhail 2010, 2012+Copyright: (c) A.V.H. McPhail 2010, 2012, 2013, 2014 Author: Vivian McPhail Maintainer: haskell.vivian.mcphail <at> gmail <dot> com Stability: experimental-Homepage: http://code.haskell.org/plot+Homepage: http://github.com/amcphail/plot Synopsis: A plotting library, exportable as eps/pdf/svg/png or renderable with gtk Description: A package for creating plots, built on top of the Cairo rendering engine. @@ -41,7 +41,10 @@ Extra-source-files: README, CHANGES, LICENSE, THANKS examples/perturbed-sine.hs,- examples/perturbed-sine.png+ examples/perturbed-sine.png,+ examples/Test.hs,+ examples/Test2.hs,+ examples/Test3.hs library