diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -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 + diff --git a/THANKS b/THANKS --- a/THANKS +++ b/THANKS @@ -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 diff --git a/examples/Test.hs b/examples/Test.hs new file mode 100644 --- /dev/null +++ b/examples/Test.hs @@ -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 diff --git a/examples/Test2.hs b/examples/Test2.hs new file mode 100644 --- /dev/null +++ b/examples/Test2.hs @@ -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 diff --git a/examples/Test3.hs b/examples/Test3.hs new file mode 100644 --- /dev/null +++ b/examples/Test3.hs @@ -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 diff --git a/lib/Graphics/Rendering/Plot/Figure.hs b/lib/Graphics/Rendering/Plot/Figure.hs --- a/lib/Graphics/Rendering/Plot/Figure.hs +++ b/lib/Graphics/Rendering/Plot/Figure.hs @@ -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) } ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot.hs b/lib/Graphics/Rendering/Plot/Figure/Plot.hs --- a/lib/Graphics/Rendering/Plot/Figure/Plot.hs +++ b/lib/Graphics/Rendering/Plot/Figure/Plot.hs @@ -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)) ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs b/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs --- a/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs +++ b/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs @@ -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) } ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Render.hs b/lib/Graphics/Rendering/Plot/Render.hs --- a/lib/Graphics/Rendering/Plot/Render.hs +++ b/lib/Graphics/Rendering/Plot/Render.hs @@ -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 +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Render/Plot.hs b/lib/Graphics/Rendering/Plot/Render/Plot.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot.hs @@ -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 diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs @@ -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 () diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs @@ -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) diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs @@ -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 ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Render/Types.hs b/lib/Graphics/Rendering/Plot/Render/Types.hs --- a/lib/Graphics/Rendering/Plot/Render/Types.hs +++ b/lib/Graphics/Rendering/Plot/Render/Types.hs @@ -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 ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Types.hs b/lib/Graphics/Rendering/Plot/Types.hs --- a/lib/Graphics/Rendering/Plot/Types.hs +++ b/lib/Graphics/Rendering/Plot/Types.hs @@ -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" ----------------------------------------------------------------------------- diff --git a/plot.cabal b/plot.cabal --- a/plot.cabal +++ b/plot.cabal @@ -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 gmail 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