├── Setup.lhs ├── examples ├── perturbed-sine.png ├── Test4.hs ├── perturbed-sine.hs ├── Test3.hs ├── Test.hs └── Test2.hs ├── .gitignore ├── THANKS ├── LICENSE ├── README ├── lib ├── Graphics │ └── Rendering │ │ ├── Plot │ │ ├── Figure │ │ │ ├── Plot │ │ │ │ ├── Legend.hs │ │ │ │ ├── Annotation.hs │ │ │ │ └── Axis.hs │ │ │ ├── Point.hs │ │ │ ├── Bar.hs │ │ │ ├── Line.hs │ │ │ ├── Simple.hs │ │ │ ├── Text.hs │ │ │ └── Plot.hs │ │ ├── Render │ │ │ ├── Plot │ │ │ │ ├── Format.hs │ │ │ │ ├── Annotation.hs │ │ │ │ ├── Glyph.hs │ │ │ │ └── Legend.hs │ │ │ ├── Plot.hs │ │ │ ├── Text.hs │ │ │ └── Types.hs │ │ ├── Render.hs │ │ ├── Defaults.hs │ │ ├── Figure.hs │ │ └── Types.hs │ │ └── Plot.hs └── Control │ └── Monad │ └── Supply.hs ├── TODO ├── CHANGES └── plot.cabal /Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /examples/perturbed-sine.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/amcphail/plot/HEAD/examples/perturbed-sine.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-newstyle 3 | docs 4 | wiki 5 | TAGS 6 | tags 7 | wip 8 | .DS_Store 9 | .*.swp 10 | .*.swo 11 | *.o 12 | *.hi 13 | *~ 14 | *# 15 | -------------------------------------------------------------------------------- /THANKS: -------------------------------------------------------------------------------- 1 | * Nicolas Dudebout for linlog and loglin in Simple.hs 2 | * uriba for a small bug fix when setting ticks 3 | * buecking added the TickFormat data type and resulting code 4 | * takano-akio pointed out bug in interaction between 5 | non-default point size and legend placement/scaling 6 | * pacak updated for AMP for ghc 7.10 7 | * pacak - clean up warnings and simplify dependencies 8 | * alang9 - implement vector functions -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) A. V. H. McPhail 2010 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of other contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | THIS README COPIED FROM THE diagrams PACKAGE 2 | 3 | Graphics.Rendering.Plot provides an embedded domain-specific 4 | language (EDSL) for creating plots rendered with Cairo 5 | 6 | For some examples of use, see http://code.haskell.org/plot/examples . 7 | 8 | ------------------------------------------------------------------------ 9 | 10 | To install the Plots library: 11 | 12 | 1. Get the dependencies 13 | 14 | The plots library uses Haskell bindings to the Cairo vector 15 | graphics library. In order to build the plots library, you 16 | will first need the following: 17 | 18 | * The Cairo library itself. This is probably available through 19 | your system's package manager and may even already be installed. 20 | On Ubuntu, for example, it is available from the 'libcairo' 21 | package. 22 | 23 | * The Haskell cairo bindings, which are packaged as part of 24 | gtk2hs. 25 | cabal install gtk2hs-buildtools 26 | cabal install gtk 27 | 28 | * The colour library, which is available from Hackage. If you use 29 | the cabal-install build option described below, the colour 30 | library will be downloaded and installed for you automatically. 31 | 32 | 2. Build 33 | 34 | * Option 1: use cabal-install 35 | 36 | If you have cabal-install, *after* installing gtk2hs, you can 37 | install plots and the remaining dependencies with 38 | cabal-install: 39 | 40 | cabal install plot 41 | 42 | Optionally, you can also pass options such as --user 43 | --prefix=$HOME to install locally. 44 | 45 | * Option 2: manual build 46 | 47 | Once all the dependencies are built and installed, you can build 48 | and install plots as follows: 49 | 50 | runhaskell Setup.lhs configure --prefix=$HOME --user 51 | runhaskell Setup.lhs build 52 | runhaskell Setup.lhs install 53 | 54 | (Optionally, you can omit the --prefix and --user arguments to the 55 | configure step, and run the install step with 'sudo' in order to 56 | install the library systemwide.) 57 | 58 | 3. Building Haddock documentation (recommended) 59 | 60 | runhaskell Setup.lhs haddock 61 | 62 | Once the documentation has been built, you can access it by 63 | pointing your browser to dist/doc/html/plot/index.html. 64 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Plot/Legend.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot.Figure.Plot.Legend 4 | -- Copyright : (c) A. V. H. McPhail 2010 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Axis 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot.Figure.Plot.Legend ( 16 | Legend 17 | , LegendBorder 18 | , LegendLocation(..), LegendOrientation(..) 19 | , clearLegend 20 | , setLegend 21 | , withLegendFormat 22 | ) where 23 | 24 | ----------------------------------------------------------------------------- 25 | 26 | import Control.Monad.State 27 | import Control.Monad.Reader 28 | 29 | import Graphics.Rendering.Plot.Types 30 | import Graphics.Rendering.Plot.Defaults 31 | 32 | import Graphics.Rendering.Plot.Figure.Text 33 | 34 | ----------------------------------------------------------------------------- 35 | 36 | -- | clear the legend 37 | clearLegend :: Legend () 38 | clearLegend = put Nothing 39 | 40 | -- | set the legend location (required for there to be a legend) 41 | setLegend :: LegendBorder -> LegendLocation -> LegendOrientation -> Legend () 42 | setLegend b l o = do 43 | to <- ask 44 | put $ Just $ Legend b l o (scaleFontSize legendLabelScale to) 45 | 46 | -- | operate on the axis label 47 | withLegendFormat :: Text () -> Legend () 48 | withLegendFormat m = do 49 | l <- get 50 | let legend = case l of 51 | Nothing -> defaultLegend 52 | Just l' -> l' 53 | to' <- ask 54 | let (FontText to _) = execText m to' (FontText to' "") 55 | put $ Just $ legend { _leg_fmt = to } 56 | 57 | ----------------------------------------------------------------------------- 58 | 59 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Render/Plot/Format.hs: -------------------------------------------------------------------------------- 1 | 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Graphics.Rendering.Plot.Render.Plot.Data 5 | -- Copyright : (c) A. V. H. McPhail 2010 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : haskell.vivian.mcphail gmail com 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Rendering 'Figure's 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Graphics.Rendering.Plot.Render.Plot.Format ( 17 | formatLineSeries 18 | , formatPointSeries 19 | , formatBarSeries 20 | ) where 21 | 22 | ----------------------------------------------------------------------------- 23 | 24 | import qualified Graphics.Rendering.Cairo as C 25 | 26 | import Graphics.Rendering.Plot.Types 27 | 28 | import Graphics.Rendering.Plot.Render.Types 29 | 30 | import Control.Monad.Reader 31 | 32 | ----------------------------------------------------------------------------- 33 | 34 | formatLineSeries' :: [Dash] -> LineWidth -> Color -> C.Render () 35 | formatLineSeries' ds lw c = do 36 | setDashes ds 37 | C.setLineWidth lw 38 | setColour c 39 | 40 | formatLineSeries :: LineType -> Render () 41 | formatLineSeries NoLine = error "line format of NoLine in a line series" 42 | formatLineSeries (ColourLine c) = do 43 | (LineOptions ds lw) <- asks (_lineoptions . _renderoptions) 44 | cairo $ formatLineSeries' ds lw c 45 | formatLineSeries (TypeLine (LineOptions ds lw) c) = 46 | cairo $ formatLineSeries' ds lw c 47 | 48 | formatPointSeries' :: Color -> C.Render () 49 | formatPointSeries' = setColour 50 | 51 | formatPointSeries :: PointType -> Render (LineWidth,Glyph) 52 | formatPointSeries (FullPoint (PointOptions pz c) g) = do 53 | cairo $ formatPointSeries' c 54 | return (pz,g) 55 | 56 | formatBarSeries' :: LineWidth -> C.Render () 57 | formatBarSeries' lw = C.setLineWidth lw 58 | 59 | formatBarSeries :: BarType -> Render (Width,Color,Color) 60 | formatBarSeries (ColourBar c) = do 61 | (BarOptions bw lw bc) <- asks (_baroptions . _renderoptions) 62 | cairo $ formatBarSeries' lw 63 | return (bw,c,bc) 64 | formatBarSeries (TypeBar (BarOptions bw lw bc) c) = do 65 | cairo $ formatBarSeries' lw 66 | return (bw,c,bc) 67 | 68 | ----------------------------------------------------------------------------- 69 | 70 | 71 | -------------------------------------------------------------------------------- /examples/Test4.hs: -------------------------------------------------------------------------------- 1 | import Graphics.Rendering.Plot 2 | import Numeric.LinearAlgebra 3 | import Numeric.GSL.Statistics 4 | import qualified Graphics.Rendering.Cairo as C 5 | import Graphics.Rendering.Pango.Enums 6 | import Graphics.UI.Gtk hiding(Circle,Cross) 7 | import Control.Monad.Trans 8 | 9 | ln = 25 10 | ts = linspace ln (0,1) 11 | rs = randomVector 0 Gaussian ln 12 | 13 | ss = sin (15*2*pi*ts) 14 | ds = 0.25*rs + ss 15 | es = constant (0.25*(stddev rs)) ln 16 | 17 | fs :: Double -> Double 18 | fs = sin . (15*2*pi*) 19 | 20 | test_graph = do 21 | withTitle $ setText "Testing plot package:" 22 | withSubTitle $ do 23 | setText "with 1 second of a 15Hz sine wave" 24 | withPointDefaults $ setPointSize 1.5 -- (A) 25 | setPlots 1 1 26 | withPlot (1,1) $ do 27 | setLegend True SouthWest Inside -- (B) 28 | addAxis XAxis (Side Lower) $ withAxisLabel $ setText "time (s)" 29 | addAxis YAxis (Side Lower) $ do 30 | withAxisLabel $ setText "amplitude" 31 | withGridLine Major $ do 32 | setDashStyle [Dash] 33 | setLineColour lightgray 34 | addAxis XAxis (Value 0) $ return () 35 | setRange YAxis Lower Linear (-1.25) 1.25 36 | setDataset (ts,[point (ds,es,"dat") (Cross,red),line (fs,"sin") blue]) 37 | setRangeFromData XAxis Lower Linear 38 | 39 | display :: ((Int,Int) -> C.Render ()) -> IO () 40 | display r = do 41 | initGUI -- is start 42 | 43 | window <- windowNew 44 | set window [ windowTitle := "Cairo test window" 45 | , windowDefaultWidth := 600 46 | , windowDefaultHeight := 400 47 | , containerBorderWidth := 1 48 | ] 49 | 50 | -- canvas <- pixbufNew ColorspaceRgb True 8 300 200 51 | -- containerAdd window canvas 52 | frame <- frameNew 53 | containerAdd window frame 54 | canvas <- drawingAreaNew 55 | containerAdd frame canvas 56 | widgetModifyBg canvas StateNormal (Color 65535 65535 65535) 57 | 58 | widgetShowAll window 59 | 60 | on canvas exposeEvent $ tryEvent $ do s <- liftIO $ widgetGetSize canvas 61 | drw <- liftIO $ widgetGetDrawWindow canvas 62 | --dat <- liftIO $ takeMVar d 63 | --liftIO $ renderWithDrawable drw (circle 50 10) 64 | liftIO $ renderWithDrawable drw (r s) 65 | 66 | onDestroy window mainQuit 67 | mainGUI 68 | 69 | 70 | main = display $ render test_graph 71 | 72 | test_render :: (Int,Int) -> C.Render () 73 | test_render = render test_graph 74 | 75 | --main = C.withSVGSurface "out.svg" 400 400 $ \surf -> C.renderWith surf $ test_render (400,400) -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | FEATURES 2 | 3 | * square plot (tie x and y shapes) (lockAspectRatio) 4 | 5 | * tick values 6 | * ticks selectable inside/outside 7 | * better tick value formatting and selection algorithm 8 | -> add (tickpos),(labelpos,labelvalue) 9 | 10 | * logarithmic minor tick positions 11 | 12 | * columns 13 | 14 | * adjustable elements ((x,y) adjustments/offsets) 15 | 16 | * settable plot sizes (so we can have same plot areas with only bottom one with x axis) 17 | 18 | * Simple interface: nice bars, histograms (see next line) 19 | 20 | * 3d plots 21 | 22 | * recycle Cairo context between invocations of renderFigure 23 | 24 | * ticks separate x axis groups for bar plots (rather than centre) 25 | 26 | * alternating shaded/transparent by major tick 27 | 28 | BUGS 29 | 30 | * Log range crashing 31 | 32 | * no ticks for greyscale? 33 | 34 | * scale (log/linear) attached to range? 35 | 36 | * logarithmic tick label width adjustment? 37 | 38 | * should scale be in setRange*? 39 | 40 | * draw axes and ticks separately so we get nice joins (refactor) 41 | actually draw tick labels separately, but not an issue any more 42 | 43 | * tick lengths too small for large axis line width? 44 | 45 | * export Data.Colour.Names 46 | 47 | * use error series for min/max for ranges 48 | 49 | REFACTOR 50 | 51 | * using padding functions not raw data structure: pdFoo, pdBar 52 | 53 | * directly to impulse, step, area, not via line (performance) 54 | 55 | * refactor Legend (LegendLocation) 56 | * replace with utility functions common code in Render/Data.hs 57 | * check Render/Data.hs, Render/Axis.hs 58 | 59 | * rationalise passing of xscale/yscale 60 | 61 | * re-refactor renderSeries for slight optimisation 62 | 63 | * re-factor Axis.hs tickPositions and renderAxisTicks 64 | 65 | * MVar data series for continuous update 66 | * autorefresh (plot-gtk?) 67 | 68 | COMPLETE 69 | 70 | | * area 71 | | * impulses 72 | | * steps 73 | | * matrix (greyscale) 74 | | * legend 75 | | * pad side opposite of axis label only if there is no label on that side 76 | | * simple interface 77 | | * option to use upper ranges 78 | | * fix linewidths (as per cairo FAQ) by adding 0.5 to rectangle start / line (borders/axes) 79 | | * expand Simple interface: xlabel, ylabel, etc... 80 | | * bars 81 | | * histogram (variable width bars) 82 | | * Graphics.Plot replacement 83 | | * log/semilog plots 84 | | * candlestick 85 | | * axis and tick joins are ugly 86 | | * annotations 87 | | * move monotone increasing check to creation of dataseries 88 | | * formattable grid lines 89 | | * cairo in device coordinates not user to avoid tiny linewidths 90 | | * getOrdData only returns lower series in MinMax series 91 | | * Candle and Whisker plots use bad sizes (remove xscale/yscale) 92 | | * fix error bars for non-points (esp. bars, hist) 93 | | * 0 in log plots should be ignored 94 | | * candle and whisker use bad width for candle part 95 | | * text labels for major ticks 96 | | * fixed rendering TickValues 97 | | * log tick label values 98 | | * bars/columns adjust for multiple data series (data creation) 99 | | * configurable plot and figure background colour 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | 0.1: 2 | * initial version 3 | 0.1.1: 4 | * add candle/whisker plots 5 | 6 | 0.1.1.1: 7 | * export MinMaxSeries 8 | 9 | 0.1.1.2: 10 | * fixed examples for Scale (Log/Linear) 11 | 12 | 0.1.1.3: 13 | * fixed bug (lack of stroke) with datasets larger than window 14 | * hollow points fill with white 15 | 16 | 0.1.1.4: 17 | * remove Unicode dependency 18 | 19 | 0.1.2: 20 | * improve axis line joins 21 | * annotations 22 | 23 | 0.1.2.1: 24 | * save/restore cairo annotation 25 | * add setDataset documentation 26 | * improve Dashes 27 | * formattable grid lines 28 | 29 | 0.1.2.2: 30 | * FormattedSeries, not DecoratedSeries in setDataset documentation 31 | 32 | 0.1.2.3: 33 | * export withGridLine 34 | 35 | 0.1.2.4: 36 | * bumped gtk dependency 37 | * changed 'State' constructor to 'state' function to reflect mtl > 2 38 | 39 | 0.1.2.5: 40 | * fixed bug in surface axis labels 41 | 42 | 0.1.2.6: 43 | * fixed treatment of 0 in log axes 44 | * fixed reversed range values 45 | * thus reverting 0.1.2.5 non-bug 46 | * export Data.Colour.Names 47 | 48 | 0.1.3.0: 49 | * change scaling so that miniscule linewidths don't occur 50 | 51 | 0.1.3.1: 52 | * fix error in scaling 53 | 54 | 0.1.3.2: 55 | * more fix treatment of 0 in log axes 56 | 57 | 0.1.3.3: 58 | * 59 | 60 | 0.1.3.4: 61 | * switch to github 62 | 63 | 0.1.3.5: 64 | * fixed .cabal repository line 65 | 66 | 0.1.4: 67 | * fix finding min/max of MinMax series 68 | * fix bar width for Candle/Whisker 69 | * fix x coordinate of Whisker 70 | * change bar width for Bar 71 | 72 | 0.1.4.1: 73 | * refactor renderSeries 74 | * fixed error bars for non-points 75 | 76 | 0.1.4.2: 77 | * fixed bug in MinMax with error (logSeriesMinMax) 78 | 79 | 0.1.5: 80 | * changed Ticks datatype 81 | * added linlog and loglin to Simple.hs 82 | * fixed points with single error series (to under/over) 83 | * fixed bug in location of `Value` axis 84 | * added data labels to axes 85 | * fix some warnings 86 | 87 | 0.1.5.1: 88 | * changed _data_label to _tick_label 89 | 90 | 0.1.6: 91 | * added TickValue renderer 92 | 93 | 0.1.6.1: 94 | * refactor tickPositions 95 | 96 | 0.1.7: 97 | * fix log labels 98 | 99 | 0.1.7.1: 100 | * small bug fix when setting ticks 101 | 102 | 0.1.8: 103 | * added `TickFormat` data type 104 | 105 | 0.2: 106 | * added `BarSetting` with `BarSpread` and `BarStack` 107 | 108 | 0.2.1: 109 | * don't use textPad when plot title is empty 110 | * add background colours for figure and plot 111 | 112 | 0.2.2: 113 | * deprecate `withTickLabelFormat` for `withTickLabelsFormat` 114 | * fix issue #5, interaction of setPointSize and Legends 115 | 116 | 0.2.3: 117 | * add sampleData action to a plot 118 | 119 | 0.2.3.1: 120 | * fix bugs (-y) in rendering annotations. Issue #7 121 | 122 | 0.2.3.2: 123 | * allow v0.13 of pango/cairo 124 | 125 | 0.2.3.3: 126 | * Update AMP Changes for ghc 7.10 127 | 128 | 0.2.3.4: 129 | * clean up warnings 130 | * use transformers instead of MaybeT 131 | 132 | 0.2.3.5: 133 | * update for hmatrix 0.17 134 | 135 | 0.2.3.7: 136 | * implement vector functions thanks to alang9 on github 137 | 138 | 0.2.3.8: 139 | * resolve ambiguity in Upper and Lower types from HMatrix 140 | 141 | 0.2.3.9: 142 | 143 | 0.2.3.10: 144 | * adapt to new MonadFail by vaibhavsagar 145 | 0.2.3.11: 146 | * enabled compilation on ghc 8.8.3, fixing Monad fail. 147 | (by hasufell) 148 | 149 | 0.2.3.12: 150 | * updated to be compatible with ghc 9.8 151 | 152 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Plot/Annotation.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot.Figure.Plot.Annotation 4 | -- Copyright : (c) A. V. H. McPhail 2010 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- 'Annotation' operations 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot.Figure.Plot.Annotation ( 16 | Annote 17 | , clearAnnotations 18 | , arrow 19 | , oval 20 | , rect 21 | , glyph 22 | , text 23 | , cairo 24 | ) where 25 | 26 | ----------------------------------------------------------------------------- 27 | 28 | --import Data.Packed.Vector 29 | 30 | import Control.Monad.State 31 | import Control.Monad.Reader 32 | 33 | import qualified Graphics.Rendering.Cairo as C 34 | 35 | import Graphics.Rendering.Plot.Types 36 | import Graphics.Rendering.Plot.Defaults 37 | 38 | ----------------------------------------------------------------------------- 39 | 40 | lineInAnnote :: Line () -> Annote LineType 41 | lineInAnnote m = do 42 | lo <- asks _lineoptions 43 | let l = execLine m lo defaultLineType 44 | return l 45 | 46 | pointInAnnote :: Point () -> Annote PointType 47 | pointInAnnote m = do 48 | po <- asks _pointoptions 49 | let p = execPoint m po defaultPointType 50 | return p 51 | 52 | barInAnnote :: Bar () -> Annote BarType 53 | barInAnnote m = do 54 | bo <- asks _baroptions 55 | let b = execBar m bo defaultBarType 56 | return b 57 | 58 | textInAnnote :: Text () -> Annote TextEntry 59 | textInAnnote m = do 60 | to <- asks _textoptions 61 | let t = execText m to NoText 62 | return t 63 | 64 | ----------------------------------------------------------------------------- 65 | 66 | -- | clear annotations 67 | clearAnnotations :: Annote () 68 | clearAnnotations = put [] 69 | 70 | -- | add an arrow 71 | arrow :: Head -> Location -> Location -> Line () -> Annote () 72 | arrow h vs vf m = do 73 | l <- lineInAnnote m 74 | modify $ \s -> (AnnArrow h l vs vf) : s 75 | 76 | -- | add an oval 77 | oval :: Fill -> Location -> Location -> Bar () -> Annote () 78 | oval p c e m = do 79 | b <- barInAnnote m 80 | modify $ \s -> (AnnOval p b c e) : s 81 | 82 | -- | add a rectangle 83 | rect :: Fill -> Location -> Location -> Bar () -> Annote () 84 | rect p rs rf m = do 85 | b <- barInAnnote m 86 | modify $ \s -> (AnnRect p b rs rf) : s 87 | 88 | -- | add a rectangle 89 | glyph :: Location -> Point () -> Annote () 90 | glyph l m = do 91 | p <- pointInAnnote m 92 | modify $ \s -> (AnnGlyph p l) : s 93 | 94 | -- | add text 95 | text :: Location -> Text () -> Annote () 96 | text l m = do 97 | t <- textInAnnote m 98 | modify $ \s -> (AnnText t l) : s 99 | 100 | -- | add a cairo render that takes the bounding box (in user coordinates) 101 | -- as an argument 102 | cairo :: (Double -> Double -> Double -> Double -> C.Render ()) -> Annote () 103 | cairo r = modify $ \s -> (AnnCairo r) : s 104 | 105 | ----------------------------------------------------------------------------- 106 | 107 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Render/Plot.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Graphics.Rendering.Plot.Render.Plot 5 | -- Copyright : (c) A. V. H. McPhail 2010 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : haskell.vivian.mcphail gmail com 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Rendering 'Figure's 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Graphics.Rendering.Plot.Render.Plot ( 17 | -- * Rendering 18 | renderPlots 19 | ) where 20 | 21 | ----------------------------------------------------------------------------- 22 | 23 | --import Data.Either 24 | 25 | --import Data.Packed.Vector 26 | --import Numeric.LinearAlgebra.Linear 27 | 28 | --import Data.Word 29 | 30 | --import Data.Maybe 31 | 32 | --import Data.Colour.SRGB 33 | --import Data.Colour.Names 34 | 35 | import qualified Data.Array.IArray as A 36 | 37 | import Data.Colour.Names 38 | 39 | import qualified Graphics.Rendering.Cairo as C 40 | --import qualified Graphics.Rendering.Pango as P 41 | 42 | --import Control.Monad.Reader 43 | import Control.Monad.State 44 | --import Control.Monad.Trans 45 | 46 | import Graphics.Rendering.Plot.Types 47 | --import Graphics.Rendering.Plot.Defaults 48 | 49 | --import Graphics.Rendering.Plot.Figure.Text 50 | 51 | import Graphics.Rendering.Plot.Render.Types 52 | 53 | import Graphics.Rendering.Plot.Render.Text 54 | import Graphics.Rendering.Plot.Render.Plot.Axis 55 | import Graphics.Rendering.Plot.Render.Plot.Data 56 | import Graphics.Rendering.Plot.Render.Plot.Legend 57 | import Graphics.Rendering.Plot.Render.Plot.Annotation 58 | 59 | --import qualified Text.Printf as Printf 60 | 61 | --import Prelude hiding(min,max) 62 | --import qualified Prelude(max) 63 | 64 | #if MIN_VERSION_mtl(2,3,0) 65 | import Control.Monad 66 | #endif 67 | 68 | ----------------------------------------------------------------------------- 69 | 70 | bbPlot :: Int -> Int -> (Int,Int) -> Render () 71 | bbPlot r c (px,py) = modify (\(BoundingBox x y w h) -> 72 | let w' = w/(fromIntegral c) 73 | h' = h/(fromIntegral r) 74 | in (BoundingBox 75 | (x+w'*((fromIntegral py)-1)) 76 | (y+h'*((fromIntegral px)-1)) 77 | w' h')) 78 | 79 | renderPlots :: Plots -> Render () 80 | renderPlots d = do 81 | let ((x,y),(x',y')) = A.bounds d 82 | rows = x'-x+1 83 | cols = y'-y+1 84 | bb <- get 85 | mapM_ (\(i,e) -> do 86 | case e of 87 | Nothing -> return () 88 | Just e' -> do 89 | bbPlot rows cols i 90 | renderPlot e' 91 | put bb) (A.assocs d) 92 | 93 | renderPlot :: PlotData -> Render () 94 | renderPlot (Plot b c p hd r a bc sd d l an) = do 95 | tx <- bbCentreWidth 96 | ty <- bbTopHeight 97 | (_,th) <- renderText hd Centre TTop tx ty 98 | when (th /= 0) $ bbLowerTop (th+textPad) 99 | legend <- renderLegend l d 100 | (axes,padding) <- renderAxes p r a 101 | renderBorder b 102 | cairo C.save 103 | clipBoundary 104 | when (c /= white) (do 105 | cairo $ do 106 | setColour c 107 | C.paint) 108 | renderData r bc sd d 109 | renderAnnotations r an 110 | cairo C.restore 111 | cairo C.save 112 | legend padding 113 | cairo C.restore 114 | cairo C.save 115 | axes 116 | cairo C.restore 117 | 118 | renderBorder :: Border -> Render () 119 | renderBorder False = return () 120 | renderBorder True = do 121 | (BoundingBox x y w h) <- get 122 | cairo $ do 123 | C.setLineWidth 0.5 124 | C.rectangle (x+0.5) (y+0.5) w h 125 | C.stroke 126 | 127 | ----------------------------------------------------------------------------- 128 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot 4 | -- Copyright : (c) A. V. H. McPhail 2010 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Graphical plots 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot ( 16 | -- * Re-exported for convenience 17 | module Graphics.Rendering.Plot.Figure.Simple 18 | , module Graphics.Rendering.Plot.Figure 19 | , module Graphics.Rendering.Plot.Render 20 | -- * Example 21 | -- $example 22 | ) where 23 | 24 | 25 | ----------------------------------------------------------------------------- 26 | 27 | import Graphics.Rendering.Plot.Figure.Simple 28 | import Graphics.Rendering.Plot.Figure 29 | import Graphics.Rendering.Plot.Render 30 | 31 | ----------------------------------------------------------------------------- 32 | {- $example 33 | 34 | Create some data: 35 | 36 | > ln = 25 37 | > ts = linspace ln (0,1) 38 | > rs = randomVector 0 Gaussian ln 39 | > 40 | > ss = sin (15*2*pi*ts) 41 | > ds = 0.25*rs + ss 42 | > es = constant (0.25*(stddev rs)) ln 43 | > 44 | > fs :: Double -> Double 45 | > fs = sin . (15*2*pi*) 46 | 47 | Perform actions in 'Figure a' to create a figure 48 | 49 | > test_graph = do 50 | > withTextDefaults $ setFontFamily "OpenSymbol" 51 | > withTitle $ setText "Testing plot package:" 52 | > withSubTitle $ do 53 | > setText "with 1 second of a 15Hz sine wave" 54 | > setFontSize 10 55 | > setPlots 1 1 56 | > withPlot (1,1) $ do 57 | > setDataset (ts,[point (ds,es) (Cross,red),line fs blue]) 58 | > addAxis XAxis (Side Lower) $ withAxisLabel $ setText "time (s)" 59 | > addAxis YAxis (Side Lower) $ withAxisLabel $ setText "amplitude" 60 | > addAxis XAxis (Value 0) $ return () 61 | > setRangeFromData XAxis Lower Linear 62 | > setRange YAxis Lower Linear (-1.25) 1.25 63 | 64 | Render the graph to a Cairo 'Render ()' action that takes the width 65 | and height of the drawing area 66 | 67 | > test_render :: (Double,Double) -> Render () 68 | > test_render = render test_graph 69 | 70 | The same graph using the 'Simple' interface 71 | 72 | > test_graph2 = do 73 | > plot (ts,[point (ds,es) (Cross,red),line fs blue]) 74 | > title "Testing plot package:" 75 | > subtitle "with 1 second of a 15Hz sine wave" 76 | > xlabel "time (s)" 77 | > ylabel "amplitude" 78 | > yrange Linear (-1.25) 1.25 79 | 80 | The 'Render a' action can be used in GTK or with Cairo to write to file in PS, PDF, SVG, or PNG 81 | 82 | Display a greyscale matrix 83 | 84 | > ms :: Matrix Double 85 | > ms = buildMatrix 64 64 (\(x,y) -> sin (2*2*pi*(fromIntegral x)/64) * cos (5*2*pi*(fromIntegral y)/64)) 86 | 87 | > mat_fig = do 88 | > setPlots 1 1 89 | > withPlot (1,1) $ do 90 | > setDataset ms 91 | > addAxis XAxis (Side Lower) $ setTickLabelFormat "%.0f" 92 | > addAxis YAxis (Side Lower) $ setTickLabelFormat "%.0f" 93 | > setRangeFromData XAxis Lower Linear 94 | > setRangeFromData YAxis Lower Linear 95 | 96 | The ODE example from hmatrix: 97 | 98 | > import Numeric.GSL 99 | > import Numeric.LinearAlgebra 100 | 101 | > xdot t [x,v] = [v, -0.95*x - 0.1*v] 102 | > ts = linspace 100 (0,20) 103 | > sol = odeSolve xdot [10,0] ts 104 | 105 | > ode_fig = plot (Line,ts,[sol]) 106 | 107 | -} 108 | 109 | ----------------------------------------------------------------------------- 110 | -------------------------------------------------------------------------------- /examples/perturbed-sine.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances #-} 2 | -- thanks to http://www.muitovar.com/gtk2hs/app1.html 3 | 4 | --module Test where 5 | 6 | import Control.Concurrent 7 | import Control.Concurrent.MVar 8 | 9 | import Control.Monad.Trans 10 | 11 | import Graphics.UI.Gtk hiding(Circle,Cross) 12 | import qualified Graphics.Rendering.Cairo as C 13 | import qualified Graphics.Rendering.Pango as P 14 | 15 | import Data.Colour.Names 16 | 17 | import Data.Packed.Vector 18 | --import Data.Packed.Random 19 | import Data.Packed() 20 | 21 | import qualified Data.Array.IArray as A 22 | 23 | import Numeric.LinearAlgebra 24 | --import Numeric.LinearAlgebra.Instances 25 | --import Numeric.LinearAlgebra.Interface 26 | 27 | import Numeric.GSL.Statistics 28 | 29 | import Graphics.Rendering.Plot 30 | 31 | import Debug.Trace 32 | 33 | ln = 25 34 | ts = linspace ln (0,1) 35 | 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] 36 | 37 | ss = sin (15*2*pi*ts) 38 | ds = 0.25*rs + ss 39 | es = constant (0.25*(stddev rs)) ln 40 | 41 | fs :: Double -> Double 42 | fs = sin . (15*2*pi*) 43 | 44 | figure = do 45 | withTextDefaults $ setFontFamily "OpenSymbol" 46 | withTitle $ setText "Testing plot package:" 47 | withSubTitle $ do 48 | setText "with 1 second of a 15Hz sine wave" 49 | setFontSize 10 50 | setPlots 1 1 51 | withPlot (1,1) $ do 52 | setDataset (ts,[point (ds,es) (Cross,red),line fs blue]) 53 | addAxis XAxis (Side Lower) $ withAxisLabel $ setText "time (s)" 54 | addAxis YAxis (Side Lower) $ withAxisLabel $ setText "amplitude" 55 | addAxis XAxis (Value 0) $ return () 56 | setRangeFromData XAxis Lower Linear 57 | setRange YAxis Lower Linear (-1.25) 1.25 58 | 59 | display :: ((Int,Int) -> C.Render ()) -> IO () 60 | display r = do 61 | initGUI -- is start 62 | 63 | window <- windowNew 64 | set window [ windowTitle := "Cairo test window" 65 | , windowDefaultWidth := 400 66 | , windowDefaultHeight := 300 67 | , containerBorderWidth := 1 68 | ] 69 | 70 | -- canvas <- pixbufNew ColorspaceRgb True 8 300 200 71 | -- containerAdd window canvas 72 | frame <- frameNew 73 | containerAdd window frame 74 | canvas <- drawingAreaNew 75 | containerAdd frame canvas 76 | widgetModifyBg canvas StateNormal (Color 65535 65535 65535) 77 | 78 | widgetShowAll window 79 | 80 | on canvas exposeEvent $ tryEvent $ do s <- liftIO $ widgetGetSize canvas 81 | drw <- liftIO $ widgetGetDrawWindow canvas 82 | --dat <- liftIO $ takeMVar d 83 | --liftIO $ renderWithDrawable drw (circle 50 10) 84 | liftIO $ renderWithDrawable drw (r s) 85 | 86 | onDestroy window mainQuit 87 | mainGUI 88 | 89 | 90 | main = display $ render figure 91 | 92 | test = writeFigure PNG "perturbed-sine.png" (400,400) figure -------------------------------------------------------------------------------- /plot.cabal: -------------------------------------------------------------------------------- 1 | Name: plot 2 | Version: 0.2.3.12 3 | License: BSD3 4 | License-file: LICENSE 5 | Copyright: (c) A.V.H. McPhail 2010, 2012-2017, 2019, 2024 6 | Author: Vivian McPhail 7 | Maintainer: haskell.vivian.mcphail gmail com 8 | Stability: experimental 9 | Homepage: http://github.com/amcphail/plot 10 | Synopsis: A plotting library, exportable as eps/pdf/svg/png or renderable with gtk 11 | Description: 12 | A package for creating plots, built on top of the Cairo rendering engine. 13 | . 14 | An ambitious attempt to replace gnuplot. 15 | . 16 | Monadic actions are used to configure a figure, which is a (rxc) array of subplots. 17 | Each plot displays a graph with optional heading, labels, legend, and annotations. 18 | The annotations themselves may be used to draw diagrams. 19 | . 20 | A figure is preprocessed in preparation for rendering by the Cairo renderer. 21 | The Cairo library can be used to output the figure to PS, PDF, SVG, and PNG file formats, 22 | or to display the figure in a GTK Drawable context. (see package 'plot-gtk'). 23 | . 24 | The preprocessed figure can be embedded as an arbitrary Cairo render, including in a diagram 25 | created with the diagram package. Conversely, arbitrary Cairo renders can be embedded in 26 | the data region of a 'Figure'. 27 | . 28 | The data series are type "Data.Packed.Vector" from hmatrix, which, when hmatrix 29 | is compiled with '-fvector', is a synonym for "Data.Vector.Storable" from the 30 | vector package and are thus compatible with packages such as statistics. 31 | . 32 | The example in Graphics.Rendering.Plot can be viewed at 33 | 34 | . 35 | . 36 | Category: Graphics 37 | 38 | Tested-with: GHC==8.8.3 39 | Cabal-version: >= 1.10 40 | Build-type: Simple 41 | 42 | Extra-source-files: README, CHANGES, LICENSE, THANKS 43 | examples/perturbed-sine.hs, 44 | examples/perturbed-sine.png, 45 | examples/Test.hs, 46 | examples/Test2.hs, 47 | examples/Test3.hs 48 | 49 | library 50 | 51 | default-language: Haskell2010 52 | 53 | Build-Depends: base >= 4.9.0.0 && < 5, 54 | mtl > 2 && < 3, array > 0.5 && < 0.6, 55 | transformers > 0.5 && < 0.7, 56 | pango >= 0.13 && < 0.14, cairo >= 0.13 && < 0.14, 57 | colour >= 2.2.1 && < 2.4, 58 | hmatrix >= 0.17 && < 0.21 59 | 60 | default-extensions: MultiParamTypeClasses 61 | GeneralizedNewtypeDeriving 62 | TypeSynonymInstances 63 | FlexibleInstances 64 | FlexibleContexts 65 | UndecidableInstances 66 | 67 | hs-source-dirs: lib 68 | Exposed-Modules: Graphics.Rendering.Plot 69 | Graphics.Rendering.Plot.Figure 70 | Graphics.Rendering.Plot.Figure.Simple 71 | Graphics.Rendering.Plot.Render 72 | 73 | Other-modules: Graphics.Rendering.Plot.Types 74 | Graphics.Rendering.Plot.Defaults 75 | Graphics.Rendering.Plot.Figure.Line 76 | Graphics.Rendering.Plot.Figure.Point 77 | Graphics.Rendering.Plot.Figure.Bar 78 | Graphics.Rendering.Plot.Figure.Text 79 | Graphics.Rendering.Plot.Figure.Plot 80 | Graphics.Rendering.Plot.Figure.Plot.Axis 81 | Graphics.Rendering.Plot.Figure.Plot.Data 82 | Graphics.Rendering.Plot.Figure.Plot.Legend 83 | Graphics.Rendering.Plot.Figure.Plot.Annotation 84 | Graphics.Rendering.Plot.Render.Types 85 | Graphics.Rendering.Plot.Render.Text 86 | Graphics.Rendering.Plot.Render.Plot 87 | Graphics.Rendering.Plot.Render.Plot.Axis 88 | Graphics.Rendering.Plot.Render.Plot.Data 89 | Graphics.Rendering.Plot.Render.Plot.Legend 90 | Graphics.Rendering.Plot.Render.Plot.Annotation 91 | Graphics.Rendering.Plot.Render.Plot.Glyph 92 | Graphics.Rendering.Plot.Render.Plot.Format 93 | Control.Monad.Supply 94 | 95 | ghc-options: -Wall -fno-warn-unused-binds 96 | 97 | ghc-prof-options: 98 | 99 | source-repository head 100 | type: git 101 | location: https://github.com/amcphail/plot 102 | -------------------------------------------------------------------------------- /examples/Test3.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances #-} 2 | {-# LANGUAGE UnicodeSyntax #-} 3 | 4 | -- thanks to http://www.muitovar.com/gtk2hs/app1.html 5 | 6 | --module Test where 7 | 8 | import Control.Concurrent 9 | import Control.Concurrent.MVar 10 | 11 | import Control.Monad.Trans 12 | 13 | import Graphics.UI.Gtk hiding(Circle,Cross) 14 | import qualified Graphics.Rendering.Cairo as C 15 | import qualified Graphics.Rendering.Pango as P 16 | 17 | import Data.Colour.Names 18 | 19 | import Data.Packed.Vector 20 | --import Data.Packed.Random 21 | import Data.Packed() 22 | 23 | --import Prelude.Unicode 24 | 25 | import qualified Data.Array.IArray as A 26 | 27 | import Numeric.LinearAlgebra 28 | 29 | import Numeric.GSL.Statistics 30 | 31 | import Graphics.Rendering.Plot 32 | 33 | import Debug.Trace 34 | 35 | ln = 25 36 | ts = linspace ln (0,1) 37 | 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] 38 | 39 | ut = linspace 25 (1::Double,100) 40 | 41 | ss = sin (15*2*pi*ts) 42 | ds = 0.25*rs + ss 43 | es = constant (0.25*(stddev rs)) ln 44 | gs = 0.40*rs - 1 45 | fs :: Double -> Double 46 | fs = sin . (15*2*pi*) 47 | 48 | ms :: Matrix Double 49 | ms = buildMatrix 64 64 (\(x,y) -> sin (2*2*pi*(fromIntegral x)/64) * cos (5*2*pi*(fromIntegral y)/64)) 50 | 51 | pts = linspace 1000 (0 :: Double,10*pi) 52 | fx = (\t -> t * sin t) pts 53 | fy = (\t -> t * cos t) pts 54 | 55 | hx = fromList [1,3,5,8,11,20,22,26,12,10,4] :: Vector Double 56 | hy = fromList [10,11,15,17,14,12,9,11,16,4,6] :: Vector Double 57 | he = fromList [11,13,16,19,16,14,19,7,10,5,3] :: Vector Double 58 | 59 | lx = fromList [1,2,3,4,5,6,7,8,9,10] ∷ Vector Double 60 | ly = fromList [50000,10000,5000,1000,500,100,50,10,1] ∷ Vector Double 61 | 62 | mx = linspace 100 (1,10) ∷ Vector Double 63 | my = linspace 100 (1,10000) ∷ Vector Double 64 | 65 | rx = scaleRecip 1 mx 66 | 67 | cx = fromList [1,2,3,4,5] ∷ Vector Double 68 | cyl = fromList [8,10,12,13,8] ∷ Vector Double 69 | cyu = fromList [10,12,16,11,10] ∷ Vector Double 70 | cel = cyl - 1 71 | ceu = cyu + 1 72 | 73 | at = linspace 1000 (0,2*pi) ∷ Vector Double 74 | ax = sin at 75 | 76 | 77 | figure = do 78 | withTextDefaults $ setFontFamily "OpenSymbol" 79 | withTitle $ setText "Multi-plot test" 80 | -- setBackgroundColour yellow 81 | setPlots 4 2 82 | 83 | mapM_ (\(x,y) -> withPlot (x,y) $ do 84 | setDataset (ts,[line ds blue]) 85 | -- setPlotBackgroundColour grey 86 | setPlotPadding 0 0 0 0 87 | addAxis XAxis (Value 0) $ do 88 | -- setGridlines Major True 89 | setTicks Major (TickNumber 5) 90 | setTicks Minor (TickNumber 41) 91 | addAxis YAxis (Side Lower) $ do 92 | setTicks Minor (TickNumber 0) 93 | setRangeFromData YAxis Lower Linear 94 | setRangeFromData XAxis Lower Linear) [(x,y)|x <- [1..4],y <- [1..2]] 95 | 96 | display :: ((Int,Int) -> C.Render ()) -> IO () 97 | display r = do 98 | initGUI -- is start 99 | 100 | window <- windowNew 101 | set window [ windowTitle := "Cairo test window" 102 | , windowDefaultWidth := 600 103 | , windowDefaultHeight := 400 104 | , containerBorderWidth := 1 105 | ] 106 | 107 | -- canvas <- pixbufNew ColorspaceRgb True 8 300 200 108 | -- containerAdd window canvas 109 | frame <- frameNew 110 | containerAdd window frame 111 | canvas <- drawingAreaNew 112 | containerAdd frame canvas 113 | widgetModifyBg canvas StateNormal (Color 65535 65535 65535) 114 | 115 | widgetShowAll window 116 | 117 | on canvas exposeEvent $ tryEvent $ do 118 | s <- liftIO $ widgetGetSize canvas 119 | drw <- liftIO $ widgetGetDrawWindow canvas 120 | --dat <- liftIO $ takeMVar d 121 | --liftIO $ renderWithDrawable drw (circle 50 10) 122 | liftIO $ renderWithDrawable drw (r s) 123 | 124 | onDestroy window mainQuit 125 | mainGUI 126 | 127 | 128 | main = display $ render figure 129 | 130 | test = writeFigure PDF "test.pdf" (400,400) figure -------------------------------------------------------------------------------- /lib/Control/Monad/Supply.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE UndecidableInstances #-} 5 | {-# LANGUAGE CPP #-} 6 | ----------------------------------------------------------------------------- 7 | -- | 8 | -- Module : Control.Monad.Supply 9 | -- Copyright : (c) A. V. H. McPhail 2010 10 | -- License : BSD3 11 | -- 12 | -- Maintainer : haskell.vivian.mcphail gmail com 13 | -- Stability : provisional 14 | -- Portability : portable 15 | -- 16 | -- a monad that supplies the next value 17 | -- 18 | ----------------------------------------------------------------------------- 19 | 20 | module Control.Monad.Supply ( 21 | Supply(..) 22 | , MonadSupply(..) 23 | , supplyN 24 | , SupplyT(..), evalSupplyT, execSupplyT 25 | , mapSupplyT 26 | ) where 27 | 28 | ----------------------------------------------------------------------------- 29 | #if !(MIN_VERSION_base(4,8,0)) 30 | import Control.Applicative 31 | #endif 32 | import Control.Monad.Writer hiding ( fail ) 33 | import Control.Monad.Reader hiding ( fail ) 34 | import Control.Monad.State hiding ( fail ) 35 | import Control.Monad.Trans() 36 | #if !MIN_VERSION_base(4,13,0) 37 | import Control.Monad.Fail ( MonadFail, fail ) 38 | import Prelude hiding ( fail ) 39 | #endif 40 | #if MIN_VERSION_mtl(2,3,0) 41 | import Control.Monad 42 | #endif 43 | ----------------------------------------------------------------------------- 44 | 45 | class Supply a b where 46 | nextSupply :: a -> (b,a) 47 | 48 | {- 49 | instance Supply [a] a where nextSupply (x:xs) = (x,xs) 50 | instance Supply ([a],[b]) a where nextSupply ((x:xs),ys) = (x,(xs,ys)) 51 | instance Supply ([a],[b]) b where nextSupply (xs,(y:ys)) = (y,(xs,ys)) 52 | -} 53 | ----------------------------------------------------------------------------- 54 | 55 | repM :: Monad m => Int -> m a -> m [a] 56 | repM 0 _ = return [] 57 | repM 1 m = do 58 | a <- m 59 | return [a] 60 | repM n m = do 61 | a <- m 62 | as <- replicateM (n-1) m 63 | return (a:as) 64 | 65 | class Monad m => MonadSupply s m | m -> s where 66 | supply :: Supply s a => m a 67 | 68 | supplyN :: (MonadSupply s m, Supply s a) => Int -> m [a] 69 | supplyN n = repM n supply 70 | 71 | ----------------------------------------------------------------------------- 72 | 73 | newtype SupplyT s m a = SupplyT { runSupplyT :: s -> m (a, s) } 74 | 75 | evalSupplyT :: Monad m => SupplyT s m a -> s -> m a 76 | evalSupplyT st s = do 77 | ~(a,_) <- runSupplyT st s 78 | return a 79 | 80 | execSupplyT :: Monad m => SupplyT s m a -> s -> m s 81 | execSupplyT st s = do 82 | ~(_,s') <- runSupplyT st s 83 | return s' 84 | 85 | mapSupplyT :: (m (a,s) -> n (b,s)) -> SupplyT s m a -> SupplyT s n b 86 | mapSupplyT f st = SupplyT $ f . runSupplyT st 87 | 88 | ----------------------------------------------------------------------------- 89 | 90 | instance Monad m => Functor (SupplyT s m) where 91 | fmap f m = SupplyT $ \s -> do 92 | ~(x, s') <- runSupplyT m s 93 | return (f x,s') 94 | instance Monad m => Applicative (SupplyT s m) where 95 | pure = return 96 | (<*>) = ap 97 | 98 | instance Monad m => Monad (SupplyT s m) where 99 | return a = SupplyT $ \s -> return (a, s) 100 | m >>= f = SupplyT $ \s -> do 101 | ~(a,s') <- runSupplyT m s 102 | runSupplyT (f a) s' 103 | 104 | instance (MonadFail m, Monad m) => MonadFail (SupplyT s m) where 105 | fail str = SupplyT $ \_ -> fail str 106 | 107 | instance MonadTrans (SupplyT s) where 108 | lift m = SupplyT $ \s -> do 109 | a <- m 110 | return (a,s) 111 | 112 | instance Monad m => MonadSupply s (SupplyT s m) where 113 | supply = SupplyT $ \s -> return $ nextSupply s 114 | 115 | ----------------------------------------------------------------------------- 116 | {- 117 | instance (Monad (t m), MonadSupply s m, MonadTrans t) => MonadSupply s (t m) where 118 | supply = lift supply 119 | -} 120 | ----------------------------------------------------------------------------- 121 | 122 | instance MonadState s m => MonadState s (SupplyT s' m) where 123 | get = lift get 124 | put = lift . put 125 | 126 | instance MonadReader r m => MonadReader r (SupplyT s m) where 127 | ask = lift ask 128 | local f m = SupplyT $ \s -> local f (runSupplyT m s) 129 | 130 | instance MonadWriter w m => MonadWriter w (SupplyT s m) where 131 | tell = lift . tell 132 | listen m = SupplyT $ \s -> do 133 | ~((a,s'),w) <- listen (runSupplyT m s) 134 | return ((a,w),s') 135 | pass m = SupplyT $ \s -> pass $ do 136 | ~((a,f),s') <- runSupplyT m s 137 | return ((a,s'),f) 138 | 139 | ----------------------------------------------------------------------------- 140 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Render/Plot/Annotation.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Graphics.Rendering.Plot.Render.Plot.Annotation 5 | -- Copyright : (c) A. V. H. McPhail 2010 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : haskell.vivian.mcphail gmail com 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Rendering 'Figure's 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Graphics.Rendering.Plot.Render.Plot.Annotation ( 17 | -- * Rendering 18 | renderAnnotations 19 | ) where 20 | 21 | ----------------------------------------------------------------------------- 22 | 23 | import qualified Graphics.Rendering.Cairo as C 24 | 25 | import Control.Monad.Reader 26 | import Control.Monad.State 27 | 28 | import Graphics.Rendering.Plot.Types 29 | --import Graphics.Rendering.Plot.Defaults 30 | 31 | --import Graphics.Rendering.Plot.Figure.Text 32 | 33 | import Graphics.Rendering.Plot.Render.Types 34 | import Graphics.Rendering.Plot.Render.Text 35 | import Graphics.Rendering.Plot.Render.Plot.Glyph 36 | import Graphics.Rendering.Plot.Render.Plot.Format 37 | 38 | --import Prelude hiding(min,max) 39 | --import qualified Prelude(max) 40 | 41 | #if MIN_VERSION_mtl(2,3,0) 42 | import Control.Monad 43 | #endif 44 | 45 | ----------------------------------------------------------------------------- 46 | 47 | renderAnnotations :: Ranges -> Annotations -> Render () 48 | renderAnnotations r an = do 49 | (BoundingBox x y w h) <- get 50 | let (xsc,xmin',xmax') = getRanges XAxis Lower r 51 | let (xmin,xmax) = if xsc == Log then (logBase 10 xmin',logBase 10 xmax') else (xmin',xmax') 52 | let xscale = w/(xmax-xmin) 53 | cairo $ C.save 54 | let (yscl,yminl',ymaxl') = getRanges YAxis Lower r 55 | let (yminl,ymaxl) = if yscl == Log then (logBase 10 yminl',logBase 10 ymaxl') else (yminl',ymaxl') 56 | let yscalel = h/(ymaxl-yminl) 57 | -- transform to data coordinates 58 | cairo $ do 59 | C.translate x (y+h) 60 | --C.scale xscale yscalel 61 | C.translate (-xmin*xscale) (yminl*yscalel) 62 | flipVertical 63 | put (BoundingBox (-xmin) (yminl) (xmax-xmin) (ymaxl-yminl)) 64 | mapM_ (renderAnnotation xscale yscalel) an 65 | put (BoundingBox x y w h) 66 | cairo $ C.restore 67 | 68 | ----------------------------------------------------------------------------- 69 | 70 | renderAnnotation :: Double -> Double -> Annotation -> Render () 71 | renderAnnotation xscale yscale (AnnArrow h lt (x1',y1') (x2',y2')) = do 72 | formatLineSeries lt 73 | let (x1,y1) = (x1'*xscale,y1'*yscale) 74 | let (x2,y2) = (x2'*xscale,y2'*yscale) 75 | cairo $ do 76 | C.moveTo x1 y1 77 | C.lineTo x2 y2 78 | C.stroke 79 | when h (do 80 | C.moveTo x2 y2 81 | let theta = atan2 (y2-y1) (x2-x1) 82 | lw <- C.getLineWidth 83 | let ln = lw*10 84 | cx = x2 - ln * cos theta 85 | cy = y2 - ln * sin theta 86 | xl = cx + (ln/2) * sin (theta + pi/2) 87 | yl = cy + (ln/2) * cos (theta + pi/2) 88 | xu = cx + (ln/2) * sin (theta - pi/2) 89 | yu = cy + (ln/2) * cos (theta - pi/2) 90 | C.lineTo xl yl 91 | C.lineTo xu yu 92 | C.closePath 93 | C.fill 94 | ) 95 | C.stroke 96 | renderAnnotation xscale yscale (AnnOval f b (x1',y1') (x2',y2')) = do 97 | (_,bc,c) <- formatBarSeries b 98 | let (x1,y1) = (x1'*xscale,y1'*yscale) 99 | let (x2,y2) = (x2'*xscale,y2'*yscale) 100 | let width = x2 - x1 101 | height = y2 - y1 102 | x = x1 + width/2 103 | y = y1 + height/2 104 | cairo $ do 105 | C.save 106 | setColour c 107 | C.translate x y 108 | C.scale (yscale/2) (xscale/2) 109 | C.arc 0 0 1 0 (2 * pi) 110 | C.restore 111 | C.strokePreserve 112 | when f (do 113 | setColour bc 114 | C.fill) 115 | C.newPath 116 | renderAnnotation xscale yscale (AnnRect f b (x1',y1') (x2',y2')) = do 117 | (_,bc,c) <- formatBarSeries b 118 | let (x1,y1) = (x1'*xscale,-y1'*yscale) 119 | let (x2,y2) = (x2'*xscale,-y2'*yscale) 120 | cairo $ do 121 | C.save 122 | setColour c 123 | flipVertical 124 | C.rectangle x1 y1 (x2-x1) (y2-y1) 125 | C.restore 126 | C.strokePreserve 127 | when f (do 128 | setColour bc 129 | C.fill) 130 | C.newPath 131 | renderAnnotation xscale yscale (AnnGlyph pt (x1',y1')) = do 132 | (pw,g) <- formatPointSeries pt 133 | let (x1,y1) = (x1'*xscale,y1'*yscale) 134 | cairo $ do 135 | C.moveTo x1 y1 136 | renderGlyph pw g 137 | renderAnnotation xscale yscale (AnnText te (x1',y1')) = do 138 | -- (x,y) <- cairo $ C.userToDevice x1 y1 139 | let (x1,y1) = (x1'*xscale,-y1'*yscale) 140 | cairo $ do 141 | C.save 142 | flipVertical 143 | _ <- renderText te TRight TTop (x1) (y1) 144 | cairo $ C.restore 145 | return () 146 | renderAnnotation xscale yscale (AnnCairo r) = do 147 | (BoundingBox x y w h) <- get 148 | cairo $ do 149 | C.save 150 | --C.translate (x) (y) 151 | C.scale (xscale) (yscale) 152 | r x y w h 153 | C.restore 154 | 155 | ----------------------------------------------------------------------------- 156 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Point.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeSynonymInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | ----------------------------------------------------------------------------- 5 | -- | 6 | -- Module : Graphics.Rendering.Plot.Figure.Point 7 | -- Copyright : (c) A. V. H. McPhail 2010 8 | -- License : BSD3 9 | -- 10 | -- Maintainer : haskell.vivian.mcphail gmail com 11 | -- Stability : provisional 12 | -- Portability : portable 13 | -- 14 | -- 'Point' operations 15 | -- 16 | ----------------------------------------------------------------------------- 17 | 18 | module Graphics.Rendering.Plot.Figure.Point ( 19 | Point, PointFormat(..) 20 | , PointSize 21 | -- , clearPointFormat 22 | , setGlyph 23 | , setPointSize 24 | , setPointColour 25 | , getPointColour 26 | ) where 27 | 28 | ----------------------------------------------------------------------------- 29 | 30 | --import Data.Word 31 | import Data.Colour 32 | --import Data.Colour.SRGB 33 | --import Data.Colour.Names 34 | 35 | --import qualified Graphics.Rendering.Cairo as C 36 | --import qualified Graphics.Rendering.Pango as P 37 | 38 | import Control.Monad.State 39 | import Control.Monad.Reader 40 | import Control.Monad.Supply 41 | 42 | import Graphics.Rendering.Plot.Types 43 | 44 | ----------------------------------------------------------------------------- 45 | 46 | changePointSize :: PointSize -> PointOptions -> PointOptions 47 | changePointSize sz (PointOptions _ c) = PointOptions sz c 48 | 49 | changePointColour :: Color -> PointOptions -> PointOptions 50 | changePointColour c (PointOptions sz _) = PointOptions sz c 51 | 52 | getPointColour :: PointType -> Color 53 | getPointColour (FullPoint (PointOptions _ c) _) = c 54 | 55 | changePointGlyph :: Glyph -> PointType -> PointType 56 | --changePointGlyph gt s (BarePoint _) = BarePoint (Glyph gt s) 57 | changePointGlyph g (FullPoint po _) = FullPoint po g 58 | 59 | ----------------------------------------------------------------------------- 60 | {- 61 | -- | clear the formatting of a point 62 | clearPointFormat :: Point () 63 | clearPointFormat = do 64 | pt <- get 65 | case pt of 66 | g@(BarePoint _) -> put g 67 | (FullPoint _ g) -> put $ BarePoint g 68 | -} 69 | 70 | changePointOptions :: (PointOptions -> PointOptions) -> PointType -> Point () 71 | --changePointOptions o (BarePoint g) = do 72 | -- po <- ask 73 | -- put $ FullPoint (o po) g 74 | changePointOptions o (FullPoint po g) = put $ FullPoint (o po) g 75 | 76 | -- | change the glyph of a point 77 | setGlyph :: Glyph -> Point () 78 | setGlyph g = modify $ \s -> changePointGlyph g s 79 | 80 | -- | change the size of a point 81 | setPointSize :: PointSize -> Point () 82 | setPointSize sz = get >>= changePointOptions (changePointSize sz) 83 | 84 | -- | change the colour of a point 85 | setPointColour :: Color -> Point () 86 | setPointColour c = get >>= changePointOptions (changePointColour c) 87 | 88 | ----------------------------------------------------------------------------- 89 | 90 | class PointFormat a where 91 | toPoint :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m PointType 92 | 93 | instance PointFormat Glyph where toPoint g = do 94 | po <- asks _pointoptions 95 | c <- supply 96 | return $ FullPoint (changePointColour c po) g 97 | --instance PointFormat GlyphType where toPoint g = return $ BarePoint g 98 | instance Real a => PointFormat (Colour a) where toPoint c = do 99 | po <- asks _pointoptions 100 | g <- supply 101 | return $ FullPoint (changePointColour (colourConvert c) po) g 102 | instance PointFormat (Glyph,PointSize) where toPoint (g,s) = do 103 | po <- asks _pointoptions 104 | c <- supply 105 | return $ FullPoint (changePointSize s $ changePointColour c po) g 106 | instance Real a => PointFormat (Glyph,Colour a) where toPoint (g,c) = do 107 | po <- asks _pointoptions 108 | return $ FullPoint (changePointColour (colourConvert c) po) g 109 | instance Real a => PointFormat (Glyph,PointSize,Colour a) where toPoint (g,s,c) = return $ FullPoint (PointOptions s (colourConvert c)) g 110 | 111 | ----------------------------------------------------------------------------- 112 | 113 | {- TODO 114 | 115 | fix Glyph/GlyphType differences 116 | NoPoint option? 117 | -} 118 | 119 | 120 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Bar.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeSynonymInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | ----------------------------------------------------------------------------- 5 | -- | 6 | -- Module : Graphics.Rendering.Plot.Figure.Bar 7 | -- Copyright : (c) A. V. H. McPhail 2010 8 | -- License : BSD3 9 | -- 10 | -- Maintainer : haskell.vivian.mcphail gmail com 11 | -- Stability : provisional 12 | -- Portability : portable 13 | -- 14 | -- 'Bar' operations 15 | -- 16 | ----------------------------------------------------------------------------- 17 | 18 | module Graphics.Rendering.Plot.Figure.Bar ( 19 | Bar, BarFormat(..) 20 | , clearBarFormat 21 | , setBarWidth 22 | , setBarColour 23 | , setBarBorderWidth 24 | , setBarBorderColour 25 | , getBarColour 26 | ) where 27 | 28 | ----------------------------------------------------------------------------- 29 | 30 | --import Data.Word 31 | import Data.Colour 32 | --import Data.Colour.Names 33 | 34 | --import qualified Graphics.Rendering.Cairo as C 35 | --import qualified Graphics.Rendering.Pango as P 36 | 37 | import Control.Monad.State 38 | import Control.Monad.Reader 39 | import Control.Monad.Supply 40 | 41 | import Graphics.Rendering.Plot.Types 42 | 43 | ----------------------------------------------------------------------------- 44 | 45 | changeBarColour :: Color -> BarType -> BarType 46 | changeBarColour c (ColourBar _) = ColourBar c 47 | changeBarColour c (TypeBar lo _) = TypeBar lo c 48 | 49 | clearBarFormatting :: BarType -> BarType 50 | clearBarFormatting l@(ColourBar _) = l 51 | clearBarFormatting (TypeBar _ c) = ColourBar c 52 | 53 | getBarColour :: BarType -> Color 54 | getBarColour (ColourBar c) = c 55 | getBarColour (TypeBar _ c) = c 56 | 57 | changeBarWidth :: Width -> BarOptions -> BarOptions 58 | changeBarWidth w (BarOptions _ bw bc) = BarOptions w bw bc 59 | 60 | changeBarBorderWidth :: LineWidth -> BarOptions -> BarOptions 61 | changeBarBorderWidth bw (BarOptions w _ bc) = BarOptions w bw bc 62 | 63 | changeBarBorderColour :: Color -> BarOptions -> BarOptions 64 | changeBarBorderColour bc (BarOptions w bw _) = BarOptions w bw bc 65 | 66 | ----------------------------------------------------------------------------- 67 | 68 | -- | clear the formatting of a line 69 | clearBarFormat :: Bar () 70 | clearBarFormat = do 71 | bt <- get 72 | case bt of 73 | c@(ColourBar _) -> put c 74 | (TypeBar _ c) -> put $ ColourBar c 75 | 76 | changeBarOptions :: (BarOptions -> BarOptions) -> BarType -> Bar () 77 | changeBarOptions o (ColourBar c) = do 78 | bo <- ask 79 | put $ TypeBar (o bo) c 80 | changeBarOptions o (TypeBar bo c) = put $ TypeBar (o bo) c 81 | 82 | -- | set the width of the bar 83 | setBarWidth :: Width -> Bar () 84 | setBarWidth bw = get >>= changeBarOptions (changeBarWidth bw) 85 | 86 | -- | set the colour of the bar 87 | setBarColour :: Color -> Bar () 88 | setBarColour c = modify (changeBarColour c) 89 | 90 | -- | set the width of the bar border 91 | setBarBorderWidth :: LineWidth -> Bar () 92 | setBarBorderWidth bw = get >>= changeBarOptions (changeBarBorderWidth bw) 93 | 94 | -- | set the colour of the bar border 95 | setBarBorderColour :: Color -> Bar () 96 | setBarBorderColour c = get >>= changeBarOptions (changeBarBorderColour c) 97 | 98 | ----------------------------------------------------------------------------- 99 | 100 | class BarFormat a where 101 | toBar :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m BarType 102 | 103 | instance BarFormat Width where toBar w = do 104 | bo <- asks _baroptions 105 | c <- supply 106 | return $ TypeBar (changeBarWidth w bo) c 107 | instance Real a => BarFormat (Colour a) where toBar c = return $ ColourBar $ colourConvert c 108 | instance Real a => BarFormat (Width,Colour a) where toBar (w,c) = do 109 | bo <- asks _baroptions 110 | return $ TypeBar (changeBarWidth w bo) $ colourConvert c 111 | instance Real a => BarFormat (Width,Colour a,LineWidth) where toBar (bw,c,lw) = do 112 | bo <- asks _baroptions 113 | return $ TypeBar (changeBarWidth bw $ changeBarBorderWidth lw bo) $ colourConvert c 114 | instance (Real a, Real b) => BarFormat (Width,Colour a,Colour b) where toBar (bw,c,bc) = do 115 | bo <- asks _baroptions 116 | return $ TypeBar (changeBarWidth bw $ changeBarBorderColour (colourConvert bc) bo) $ colourConvert c 117 | instance (Real a, Real b) => BarFormat (Width,Colour a,LineWidth,Colour b) where toBar (bw,c,lw,bc) = return $ TypeBar (BarOptions bw lw (colourConvert bc)) $ colourConvert c 118 | 119 | ----------------------------------------------------------------------------- 120 | 121 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Graphics.Rendering.Plot.Figure.Plot.Axis 5 | -- Copyright : (c) A. V. H. McPhail 2010 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : haskell.vivian.mcphail gmail com 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Axis 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Graphics.Rendering.Plot.Figure.Plot.Axis ( 17 | Axis 18 | , AxisType(..),AxisSide(..),AxisPosn(..) 19 | , Tick(..), TickValues(..), GridLines 20 | , TickFormat(..) 21 | , setTicks 22 | , setGridlines 23 | , setTickLabelFormat 24 | , setTickLabels 25 | , withTickLabelsFormat 26 | , withAxisLabel 27 | , withAxisLine 28 | , withGridLine 29 | ) where 30 | 31 | ----------------------------------------------------------------------------- 32 | 33 | import Data.Maybe (fromMaybe) 34 | 35 | import Control.Monad.State 36 | import Control.Monad.Reader 37 | #if MIN_VERSION_mtl(2,3,0) 38 | import Control.Monad 39 | #endif 40 | 41 | import Graphics.Rendering.Plot.Types 42 | import Graphics.Rendering.Plot.Defaults 43 | 44 | ----------------------------------------------------------------------------- 45 | 46 | changeLineType :: LineType -> AxisData -> AxisData 47 | changeLineType lt ax = ax { _line_type = lt } 48 | 49 | changeMinorTicks :: (Maybe Ticks -> Maybe Ticks) -> AxisData -> AxisData 50 | changeMinorTicks t ax = ax { _minor_ticks = t (_minor_ticks ax) } 51 | 52 | changeMajorTicks :: (Maybe Ticks -> Maybe Ticks) -> AxisData -> AxisData 53 | changeMajorTicks t ax = ax { _major_ticks = t (_major_ticks ax) } 54 | 55 | changeTickFormat :: TickFormat -> AxisData -> AxisData 56 | changeTickFormat tf ax = ax { _tick_format = tf } 57 | 58 | changeLabel :: (TextEntry -> TextEntry) -> AxisData -> AxisData 59 | changeLabel f ax = ax { _label = f (_label ax) } 60 | 61 | changeTickLabels :: ([TextEntry] -> [TextEntry]) -> AxisData -> AxisData 62 | changeTickLabels f ax = ax { _tick_labels = f (_tick_labels ax) } 63 | 64 | ----------------------------------------------------------------------------- 65 | 66 | -- | format the axis line 67 | withAxisLine :: Line () -> Axis () 68 | withAxisLine m = do 69 | l <- gets _line_type 70 | lo <- asks _lineoptions 71 | let lt = execLine m lo l 72 | modify $ \s -> s { _line_type = lt } 73 | 74 | -- | format the grid lines 75 | withGridLine :: Tick -> Line () -> Axis () 76 | withGridLine t m = do 77 | lo <- asks _lineoptions 78 | (lt',v) <- case t of 79 | Minor -> do 80 | -- at this point can we guarantee there won't 81 | -- be a Nothing? 82 | (Ticks lt'' v') <- fromMaybe (error "Minor ticks was Nothing") <$> gets _minor_ticks 83 | return (lt'',v') 84 | Major -> do 85 | (Ticks lt'' v') <- fromMaybe (error "Major ticks was Nothing") <$> gets _major_ticks 86 | return (lt'',v') 87 | let lt = execLine m lo lt' 88 | case t of 89 | Minor -> modify $ \s -> s { _minor_ticks = (Just (Ticks lt v)) } 90 | Major -> modify $ \s -> s { _major_ticks = (Just (Ticks lt v)) } 91 | 92 | -- | format the axis ticks 93 | setTicks :: Tick -> TickValues -> Axis () 94 | setTicks Minor (TickNumber 0) = modify $ \s -> 95 | changeMinorTicks (const Nothing) s 96 | setTicks Minor ts = modify $ \s -> 97 | changeMinorTicks (setTickValues ts) s 98 | setTicks Major (TickNumber 0) = modify $ \s -> 99 | changeMajorTicks (const Nothing) s 100 | setTicks Major ts = modify $ \s -> 101 | changeMajorTicks (setTickValues ts) s 102 | 103 | -- | should gridlines be displayed? 104 | setGridlines :: Tick -> GridLines -> Axis () 105 | setGridlines Minor gl = modify $ \s -> 106 | changeMinorTicks (setTickGridlines (if gl then defaultGridLine else NoLine)) s 107 | setGridlines Major gl = modify $ \s -> 108 | changeMajorTicks (setTickGridlines (if gl then defaultGridLine else NoLine)) s 109 | 110 | -- | set the tick label format 111 | setTickLabelFormat :: TickFormat -> Axis () 112 | setTickLabelFormat tf = modify $ \s -> changeTickFormat tf s 113 | 114 | -- | a list of data labels 115 | setTickLabels :: [String] -> Axis () 116 | setTickLabels dl = modify $ \s -> 117 | changeTickLabels (const (map BareText dl)) s 118 | 119 | -- | format the tick labels 120 | withTickLabelsFormat :: Text () -> Axis () 121 | withTickLabelsFormat m = do 122 | ax <- get 123 | to <- asks _textoptions 124 | put $ ax { _tick_labels = map (execText m to) (_tick_labels ax) } 125 | 126 | -- | operate on the axis label 127 | withAxisLabel :: Text () -> Axis () 128 | withAxisLabel m = do 129 | ax <- get 130 | to <- asks _textoptions 131 | put $ ax { _label = execText m to (_label ax) } 132 | 133 | ----------------------------------------------------------------------------- 134 | 135 | -- | format the tick labels 136 | {- DEPRECATED "use `withTickLabelsFormat`" -} 137 | withTickLabelFormat :: Text () -> Axis () 138 | withTickLabelFormat m = do 139 | ax <- get 140 | to <- asks _textoptions 141 | put $ ax { _tick_labels = map (execText m to) (_tick_labels ax) } 142 | 143 | ----------------------------------------------------------------------------- 144 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Line.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeSynonymInstances #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE FlexibleContexts #-} 4 | ----------------------------------------------------------------------------- 5 | -- | 6 | -- Module : Graphics.Rendering.Plot.Figure.Line 7 | -- Copyright : (c) A. V. H. McPhail 2010 8 | -- License : BSD3 9 | -- 10 | -- Maintainer : haskell.vivian.mcphail gmail com 11 | -- Stability : provisional 12 | -- Portability : portable 13 | -- 14 | -- 'Text' operations 15 | -- 16 | ----------------------------------------------------------------------------- 17 | 18 | module Graphics.Rendering.Plot.Figure.Line ( 19 | Line, LineFormat(..) 20 | , DashStyle,Dash(..),LineWidth 21 | , clearLineFormat 22 | , setDashStyle 23 | , setLineWidth 24 | , setLineColour 25 | , getLineColour 26 | ) where 27 | 28 | ----------------------------------------------------------------------------- 29 | 30 | --import Data.Word 31 | import Data.Colour 32 | --import Data.Colour.Names 33 | 34 | --import qualified Graphics.Rendering.Cairo as C 35 | --import qualified Graphics.Rendering.Pango as P 36 | 37 | import Control.Monad.State 38 | import Control.Monad.Reader 39 | import Control.Monad.Supply 40 | 41 | import Graphics.Rendering.Plot.Types 42 | 43 | ----------------------------------------------------------------------------- 44 | 45 | changeDashStyle :: DashStyle -> LineOptions -> LineOptions 46 | changeDashStyle ds (LineOptions _ lw) = LineOptions ds lw 47 | 48 | changeLineWidth :: LineWidth -> LineOptions -> LineOptions 49 | changeLineWidth lw (LineOptions ds _) = LineOptions ds lw 50 | 51 | {-changeLineOptions :: (LineOptions -> LineOptions) -> LineType -> LineType 52 | changeLineOptions f (LineType ls c) = LineType (f ls) c 53 | 54 | changeDashStyle :: DashStyle -> LineType -> LineType 55 | changeDashStyle ds = changeLineOptions (changeDashStyleStyle ds) 56 | 57 | changeLineWidth :: LineWidth -> LineType -> LineType 58 | changeLineWidth lw = changeLineOptions (changeLineWidthStyle lw) 59 | -} 60 | changeLineColour :: Color -> LineType -> LineType 61 | changeLineColour c NoLine = ColourLine c 62 | changeLineColour c (ColourLine _) = ColourLine c 63 | changeLineColour c (TypeLine lo _) = TypeLine lo c 64 | 65 | clearLineFormatting :: LineType -> LineType 66 | clearLineFormatting NoLine = NoLine 67 | clearLineFormatting l@(ColourLine _) = l 68 | clearLineFormatting (TypeLine _ c) = ColourLine c 69 | 70 | clearLine :: LineType -> LineType 71 | clearLine _ = NoLine 72 | 73 | getLineColour :: LineType -> Maybe Color 74 | getLineColour NoLine = Nothing 75 | getLineColour (ColourLine c) = Just c 76 | getLineColour (TypeLine _ c) = Just c 77 | 78 | ----------------------------------------------------------------------------- 79 | 80 | -- | clear the formatting of a line 81 | clearLineFormat :: Line () 82 | clearLineFormat = do 83 | lt <- get 84 | case lt of 85 | NoLine -> put NoLine 86 | c@(ColourLine _) -> put c 87 | (TypeLine _ c) -> put $ ColourLine c 88 | 89 | changeLineOptions :: (LineOptions -> LineOptions) -> LineType -> Line () 90 | changeLineOptions o NoLine = do 91 | lo <- ask 92 | put $ TypeLine (o lo) black 93 | changeLineOptions o (ColourLine c) = do 94 | lo <- ask 95 | put $ TypeLine (o lo) c 96 | changeLineOptions o (TypeLine lo c) = put $ TypeLine (o lo) c 97 | 98 | -- | change the dash style of a line 99 | setDashStyle :: DashStyle -> Line () 100 | setDashStyle ds = get >>= changeLineOptions (changeDashStyle ds) 101 | 102 | -- | change the line width of a line 103 | setLineWidth :: LineWidth -> Line () 104 | setLineWidth lw = get >>= changeLineOptions (changeLineWidth lw) 105 | 106 | -- | change the line colour of a line 107 | setLineColour :: Color -> Line () 108 | setLineColour c = modify (changeLineColour c) 109 | 110 | ----------------------------------------------------------------------------- 111 | 112 | class LineFormat a where 113 | toLine :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m LineType 114 | 115 | instance Real a => LineFormat (Colour a) where toLine c = return $ ColourLine $ colourConvert c 116 | instance LineFormat DashStyle where toLine ds = do 117 | lo <- asks _lineoptions 118 | c <- supply 119 | return $ TypeLine (changeDashStyle ds lo) c 120 | instance LineFormat LineWidth where toLine lw = do 121 | lo <- asks _lineoptions 122 | c <- supply 123 | return $ TypeLine (changeLineWidth lw lo) c 124 | instance Real a => LineFormat (DashStyle,Colour a) where toLine (ds,c) = do 125 | lo <- asks _lineoptions 126 | return $ TypeLine (changeDashStyle ds lo) $ colourConvert c 127 | instance Real a => LineFormat (LineWidth,Colour a) where toLine (lw,c) = do 128 | lo <- asks _lineoptions 129 | return $ TypeLine (changeLineWidth lw lo) $ colourConvert c 130 | instance LineFormat (DashStyle,LineWidth) where toLine (ds,lw) = do 131 | c <- supply 132 | return $ TypeLine (LineOptions ds lw) c 133 | instance Real a => LineFormat (DashStyle,LineWidth,Colour a) where toLine (ds,lw,c) = return $ TypeLine (LineOptions ds lw) $ colourConvert c 134 | 135 | ----------------------------------------------------------------------------- 136 | 137 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Render/Plot/Glyph.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot.Render.Plot.Glyph 4 | -- Copyright : (c) A. V. H. McPhail 2010 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Rendering 'Figure's 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot.Render.Plot.Glyph ( 16 | -- * Rendering 17 | renderGlyph 18 | ) where 19 | 20 | ----------------------------------------------------------------------------- 21 | 22 | import qualified Graphics.Rendering.Cairo as C 23 | 24 | import Graphics.Rendering.Plot.Types 25 | 26 | ----------------------------------------------------------------------------- 27 | 28 | glyphWidth :: Double 29 | glyphWidth = 2*pi 30 | 31 | renderGlyph :: LineWidth -> Glyph -> C.Render () 32 | renderGlyph pz g = do 33 | C.save 34 | C.scale pz pz 35 | C.setLineWidth pz 36 | renderGlyph' g 37 | C.restore 38 | where renderGlyph' Box = renderGlyphBox 39 | renderGlyph' Cross = renderGlyphCross 40 | renderGlyph' Diamond = renderGlyphDiamond 41 | renderGlyph' Asterisk = renderGlyphAsterisk 42 | renderGlyph' Triangle = renderGlyphTriangle 43 | renderGlyph' Circle = renderGlyphCircle 44 | renderGlyph' Bullet = renderGlyphBullet 45 | renderGlyph' Top = renderGlyphTop 46 | renderGlyph' Bot = renderGlyphBot 47 | --renderGlyph _ _ _ = return () 48 | 49 | difference :: Num a => [a] -> [a] 50 | difference [] = [] 51 | difference [_] = [] 52 | difference (x0:x1:xs) = (x1-x0):(difference (x1:xs)) 53 | 54 | renderGlyphBox :: C.Render () 55 | renderGlyphBox = do 56 | let x = glyphWidth 57 | y = glyphWidth 58 | C.relMoveTo (-x/2) (-y/2) 59 | C.relLineTo 0 y 60 | C.relLineTo x 0 61 | C.relLineTo 0 (-y) 62 | C.closePath 63 | C.strokePreserve 64 | C.save 65 | C.setSourceRGBA 1 1 1 1 66 | C.fill 67 | C.restore 68 | 69 | renderGlyphCross :: C.Render () 70 | renderGlyphCross = do 71 | let x = glyphWidth 72 | y = glyphWidth 73 | C.relMoveTo (-x/2) 0 74 | C.relLineTo x 0 75 | C.relMoveTo (-x/2) (-y/2) 76 | C.relLineTo 0 y 77 | C.closePath 78 | C.stroke 79 | 80 | renderGlyphDiamond :: C.Render () 81 | renderGlyphDiamond = do 82 | let x = glyphWidth 83 | y = glyphWidth 84 | C.relMoveTo (-x/2) 0 85 | C.relLineTo (x/2) y 86 | C.relLineTo (x/2) (-y) 87 | C.relLineTo (-x/2) (-y) 88 | C.closePath 89 | C.strokePreserve 90 | C.save 91 | C.setSourceRGBA 1 1 1 1 92 | C.fill 93 | C.restore 94 | C.stroke 95 | 96 | renderGlyphAsterisk :: C.Render () 97 | renderGlyphAsterisk = do 98 | let radius = glyphWidth/2 99 | angles' = map ((+ 90) . (* (360 `div` 5))) [0..4] 100 | angles = map ((* (2*pi/360)) . fromInteger . (`mod` 360)) angles' 101 | xs = map ((* (radius)) . cos) angles 102 | ys = map ((* (radius)) . sin) angles 103 | mapM_ (\(x,y) -> do 104 | C.relLineTo x y 105 | C.relMoveTo (-x) (-y)) (zip xs ys) 106 | C.stroke 107 | 108 | renderGlyphTriangle :: C.Render () 109 | renderGlyphTriangle = do 110 | let radius = glyphWidth/2 111 | angles' = [90,210,330] 112 | --angles' = map ((flip (+) 90) . (* (360 `div` 3))) [0..2] 113 | angles = map ((* (2*pi/360)) . fromInteger . (`mod` 360)) angles' 114 | x@(sx:_) = map ((* (radius)) . cos) angles 115 | y@(sy:_) = map ((* (radius)) . sin) angles 116 | xs = difference x 117 | ys = difference y 118 | C.relMoveTo sx sy 119 | mapM_ (uncurry C.relLineTo) (zip xs ys) 120 | C.closePath 121 | C.strokePreserve 122 | C.save 123 | C.setSourceRGBA 1 1 1 1 124 | C.fill 125 | C.restore 126 | 127 | renderGlyphCircle :: C.Render () 128 | renderGlyphCircle = do 129 | let radius = glyphWidth/2 130 | angles = map (*(2*pi/36)) [0..35] 131 | x@(sx:_) = map ((* (radius)) . cos) angles 132 | y@(sy:_) = map ((* (radius)) . sin) angles 133 | xs = difference x 134 | ys = difference y 135 | C.relMoveTo sx sy 136 | mapM_ (uncurry C.relLineTo) (zip xs ys) 137 | C.closePath 138 | C.strokePreserve 139 | C.save 140 | C.setSourceRGBA 1 1 1 1 141 | C.fill 142 | C.restore 143 | 144 | renderGlyphBullet :: C.Render () 145 | renderGlyphBullet = do 146 | let radius = glyphWidth/2 147 | angles = map (*(2*pi/36)) [0..35] 148 | x@(sx:_) = map ((* (radius)) . cos) angles 149 | y@(sy:_) = map ((* (radius)) . sin) angles 150 | xs = difference x 151 | ys = difference y 152 | C.relMoveTo sx sy 153 | mapM_ (uncurry C.relLineTo) (zip xs ys) 154 | C.closePath 155 | C.fill 156 | C.stroke 157 | 158 | renderGlyphTop :: C.Render () 159 | renderGlyphTop = do 160 | let x = glyphWidth 161 | y = glyphWidth 162 | C.relMoveTo (-x/2) 0 163 | C.relLineTo x 0 164 | C.relMoveTo (-x/2) 0 165 | C.relLineTo 0 (-y) 166 | C.stroke 167 | 168 | renderGlyphBot :: C.Render () 169 | renderGlyphBot = do 170 | let x = glyphWidth 171 | y = glyphWidth 172 | C.relMoveTo (-x/2) 0 173 | C.relLineTo x 0 174 | C.relMoveTo (-x/2) 0 175 | C.relLineTo 0 (y) 176 | C.stroke 177 | 178 | ----------------------------------------------------------------------------- 179 | 180 | 181 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Render.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Graphics.Rendering.Plot.Render 5 | -- Copyright : (c) A. V. H. McPhail 2010 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : haskell.vivian.mcphail gmail com 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Rendering 'Figure's 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Graphics.Rendering.Plot.Render ( 17 | -- * Rendering 18 | render 19 | -- ** Access to 'FigureState' 20 | , newFigureState 21 | , updateFigureState 22 | , renderFigureState 23 | -- ** Outputting to file 24 | , OutputType(..) 25 | , writeFigure 26 | , writeFigureState 27 | -- * Notes 28 | -- $notes 29 | ) where 30 | 31 | ----------------------------------------------------------------------------- 32 | {- TODO 33 | 34 | store 'next colour' list in state 35 | -} 36 | ----------------------------------------------------------------------------- 37 | 38 | --import Data.Either 39 | 40 | --import Data.Packed.Vector 41 | --import Numeric.LinearAlgebra.Linear 42 | 43 | --import Data.Word 44 | 45 | --import Data.Maybe 46 | 47 | --import Data.Colour.SRGB 48 | --import Data.Colour.Names 49 | 50 | --import qualified Data.Array.IArray as A 51 | 52 | import qualified Graphics.Rendering.Cairo as C 53 | import qualified Graphics.Rendering.Pango as P 54 | 55 | --import Control.Monad.Reader 56 | --import Control.Monad.State 57 | --import Control.Monad.Trans 58 | 59 | import Graphics.Rendering.Plot.Types 60 | import Graphics.Rendering.Plot.Defaults 61 | 62 | --import Graphics.Rendering.Plot.Figure.Text 63 | 64 | import Graphics.Rendering.Plot.Render.Types 65 | import Graphics.Rendering.Plot.Render.Text 66 | import Graphics.Rendering.Plot.Render.Plot 67 | 68 | --import qualified Text.Printf as Printf 69 | 70 | --import Prelude hiding(min,max) 71 | --import qualified Prelude(max) 72 | 73 | ----------------------------------------------------------------------------- 74 | 75 | -- | render a 'Figure' 76 | render :: Figure () -- ^ the figure to be rendered 77 | -> (Int,Int) -- ^ (width,height) 78 | -> C.Render () -- ^ a Cairo operation 79 | render g = (\(w,h) -> do 80 | pc <- pango $ P.cairoCreateContext Nothing 81 | to <- pango $ getDefaultTextOptions pc 82 | let options' = Options defaultLineOptions 83 | defaultPointOptions defaultBarOptions to 84 | let (FigureState options _ figure) = 85 | execFigure g (FigureState options' defaultSupply emptyFigure) 86 | evalRender (renderFigure figure) (RenderEnv pc options) 87 | (BoundingBox 0 0 (fromIntegral w) (fromIntegral h))) 88 | 89 | ----------------------------------------------------------------------------- 90 | 91 | -- | create 'FigureState' from a series of 'Figure' actions 92 | newFigureState :: Figure () -> IO FigureState 93 | newFigureState f = do 94 | pc <- P.cairoCreateContext Nothing 95 | to <- getDefaultTextOptions pc 96 | let options' = Options defaultLineOptions 97 | defaultPointOptions defaultBarOptions to 98 | return $ execFigure f (FigureState options' defaultSupply emptyFigure) 99 | 100 | -- | modify a 'FigureState' with some new actions 101 | updateFigureState :: FigureState -> Figure () -> FigureState 102 | updateFigureState s f = execFigure f s 103 | 104 | -- | render a 'FigureState' 105 | renderFigureState :: FigureState -- ^ the figure state 106 | -> (Int,Int) -- ^ (width,height) 107 | -> C.Render () -- ^ a Cairo operation 108 | renderFigureState (FigureState options _ figure) = (\(w,h) -> do 109 | pc <- pango $ P.cairoCreateContext Nothing 110 | evalRender (renderFigure figure) (RenderEnv pc options) 111 | (BoundingBox 0 0 (fromIntegral w) (fromIntegral h))) 112 | 113 | ----------------------------------------------------------------------------- 114 | 115 | -- | output the 'Figure' 116 | writeFigure :: OutputType -- ^ output file type 117 | -> FilePath -- ^ file path 118 | -> (Int,Int) -- ^ (width,height) 119 | -> Figure () -- ^ the 'Figure' rendering operation 120 | -> IO () 121 | writeFigure PNG fn wh f = withImageSurface wh (writeSurfaceToPNG fn (render f wh)) 122 | writeFigure PS fn wh f = writeSurface C.withPSSurface fn wh f 123 | writeFigure PDF fn wh f = writeSurface C.withPDFSurface fn wh f 124 | writeFigure SVG fn wh f = writeSurface C.withSVGSurface fn wh f 125 | 126 | withImageSurface :: (Int,Int) -> (C.Surface -> IO ()) -> IO () 127 | withImageSurface (w,h) = C.withImageSurface C.FormatARGB32 w h 128 | 129 | writeSurfaceToPNG :: FilePath -> C.Render () -> C.Surface -> IO () 130 | writeSurfaceToPNG fn r s = do 131 | C.renderWith s r 132 | C.surfaceWriteToPNG s fn 133 | 134 | writeSurface :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) 135 | -> FilePath -> (Int,Int) -> Figure () -> IO () 136 | writeSurface rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) 137 | (flip C.renderWith (render f (w,h))) 138 | 139 | ----------------------------------------------------------------------------- 140 | 141 | -- | output the 'FigureState' 142 | writeFigureState :: OutputType -- ^ output file type 143 | -> FilePath -- ^ file path 144 | -> (Int,Int) -- ^ (width,height) 145 | -> FigureState -- ^ a FigureState 146 | -> IO () 147 | writeFigureState PNG fn wh f = withImageSurface wh 148 | (writeSurfaceToPNG fn (renderFigureState f wh)) 149 | writeFigureState PS fn wh f = writeSurfaceFS C.withPSSurface fn wh f 150 | writeFigureState PDF fn wh f = writeSurfaceFS C.withPDFSurface fn wh f 151 | writeFigureState SVG fn wh f = writeSurfaceFS C.withSVGSurface fn wh f 152 | 153 | writeSurfaceFS :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) 154 | -> FilePath -> (Int,Int) -> FigureState -> IO () 155 | writeSurfaceFS rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) 156 | (flip C.renderWith (renderFigureState f (w,h))) 157 | 158 | ----------------------------------------------------------------------------- 159 | 160 | renderFigure :: FigureData -> Render () 161 | renderFigure (Figure b p t s d) = do 162 | cairo $ do 163 | C.save 164 | setColour b 165 | C.paint 166 | C.restore 167 | 168 | applyPads p 169 | 170 | tx <- bbCentreWidth 171 | ty <- bbTopHeight 172 | (_,th) <- renderText t Centre TTop tx ty 173 | bbLowerTop (th+textPad) 174 | 175 | sx <- bbCentreWidth 176 | sy <- bbTopHeight 177 | (_,sh) <- renderText s Centre TTop sx sy 178 | bbLowerTop (sh+textPad) 179 | 180 | renderPlots d 181 | 182 | ----------------------------------------------------------------------------- 183 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Render/Text.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot.Render.Text 4 | -- Copyright : (c) A. V. H. McPhail 2010 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Rendering 'Figure's 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot.Render.Text ( 16 | -- * Rendering 17 | renderText 18 | , renderTextVertical 19 | -- * Internal 20 | , textSize 21 | , textSizeVertical 22 | , showText 23 | , formatText 24 | ) where 25 | 26 | ----------------------------------------------------------------------------- 27 | 28 | --import Data.Either 29 | 30 | --import Data.Packed.Vector 31 | --import Numeric.LinearAlgebra.Linear 32 | 33 | --import Data.Word 34 | 35 | --import Data.Maybe 36 | 37 | --import Data.Colour.SRGB 38 | --import Data.Colour.Names 39 | 40 | ---import qualified Data.Array.IArray as A 41 | 42 | import qualified Graphics.Rendering.Cairo as C 43 | import qualified Graphics.Rendering.Pango as P 44 | 45 | import Control.Monad.Reader 46 | --import Control.Monad.State 47 | --import Control.Monad.Trans 48 | 49 | import Graphics.Rendering.Plot.Types 50 | --import Graphics.Rendering.Plot.Defaults 51 | 52 | import Graphics.Rendering.Plot.Figure.Text 53 | 54 | import Graphics.Rendering.Plot.Render.Types 55 | 56 | --import qualified Text.Printf as Printf 57 | 58 | --import Prelude hiding(min,max) 59 | --import qualified Prelude(max) 60 | 61 | ----------------------------------------------------------------------------- 62 | 63 | textSize :: P.PangoLayout -> TextXAlign -> TextYAlign -> Double -> Double -> C.Render ((Double,Double),(Double,Double)) 64 | textSize l xa ya x y = do 65 | (_,P.PangoRectangle _ _ w h) <- pango $ P.layoutGetExtents l 66 | return ((xStart xa x w h,yStart ya y w h),(w,h)) 67 | where xStart TLeft x' w' _ = x' - w' 68 | xStart Centre x' w' _ = x' - (w'/2) 69 | xStart TRight x' _ _ = x' 70 | yStart TBottom y' _ h' = y' - h' 71 | yStart Middle y' _ h' = y' - (h'/2) 72 | yStart TTop y' _ _ = y' 73 | 74 | textSizeVertical :: P.PangoLayout -> TextXAlign -> TextYAlign -> Double -> Double -> C.Render ((Double,Double),(Double,Double)) 75 | textSizeVertical l xa ya x y = do 76 | (_,P.PangoRectangle _ _ w h) <- pango $ P.layoutGetExtents l 77 | return ((xStart xa x w h,yStart ya y w h),(w,h)) 78 | where xStart TLeft x' _ w' = x' - w' 79 | xStart Centre x' _ w' = x' - (w'/2) 80 | xStart TRight x' _ _ = x' 81 | yStart TBottom y' _ _ = y' 82 | yStart Middle y' h' _ = y' + (h'/2) 83 | yStart TTop y' h' _ = y' + (h') 84 | 85 | showText :: P.PangoLayout -> Double -> Double -> C.Render () 86 | showText pl x y = do 87 | C.moveTo x y 88 | P.showLayout pl 89 | 90 | ----------------------------------------------------------------------------- 91 | 92 | formatText :: TextEntry -> Render TextEntry 93 | formatText te@NoText = return te 94 | formatText (BareText s) = do 95 | to <- asks (_textoptions . _renderoptions) 96 | return (FontText to s) 97 | formatText (SizeText fz c s) = do 98 | to <- asks (_textoptions . _renderoptions) 99 | return $ (FontText (changeFontSize fz $ changeFontColour c to) s) 100 | formatText te@(FontText _ _) = return te 101 | 102 | {- 103 | getTextSize :: Text -> Render (Double,Double) 104 | getTextSize (Text Nothing s) = do 105 | to <- asks _text 106 | getTextSize (Text to s) 107 | getTextSize (Text (Just (TextOptions (FontOptions ff fs fw) fz _)) s) = cairo $ do 108 | C.selectFontFace ff fs fw 109 | C.setFontSize fz 110 | te <- C.textExtents s 111 | return (C.textExtentsWidth te,C.textExtentsHeight te) 112 | -} 113 | renderText :: TextEntry -> TextXAlign -> TextYAlign -> Double -> Double -> Render (Double,Double) 114 | renderText NoText _ _ _ _ = return (0,0) 115 | renderText te@(BareText _) xa ya x y = do 116 | te' <- formatText te 117 | renderText te' xa ya x y 118 | renderText te@(SizeText _ _ _) xa ya x y = do 119 | te' <- formatText te 120 | renderText te' xa ya x y 121 | renderText (FontText to s) xa ya x y = do 122 | pc <- asks _pangocontext 123 | cairo $ do 124 | lo <- pango $ P.layoutText pc s 125 | setTextOptions to lo 126 | ((x',y'),twh) <- textSize lo xa ya x y 127 | showText lo x' y' 128 | return twh 129 | 130 | renderTextVertical :: TextEntry -> TextXAlign -> TextYAlign -> Double -> Double -> Render (Double,Double) 131 | renderTextVertical NoText _ _ _ _ = return (0,0) 132 | renderTextVertical te@(BareText _) xa ya x y = do 133 | te' <- formatText te 134 | renderTextVertical te' xa ya x y 135 | renderTextVertical te@(SizeText _ _ _) xa ya x y = do 136 | te' <- formatText te 137 | renderTextVertical te' xa ya x y 138 | renderTextVertical (FontText to s) xa ya x y = do 139 | pc <- asks _pangocontext 140 | cairo $ do 141 | lo <- pango $ P.layoutText pc s 142 | setTextOptions to lo 143 | C.save 144 | C.rotate (-pi/2) 145 | P.updateLayout lo 146 | ((x',y'),twh) <- textSizeVertical lo xa ya x y 147 | showText lo (-y') (x') 148 | C.restore 149 | return twh 150 | 151 | ----------------------------------------------------------------------------- 152 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Simple.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot.Figure 4 | -- Copyright : (c) A. V. H. McPhail 2010, 2015 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- One line 'Figure' creation 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot.Figure.Simple ( 16 | -- * Plotting 17 | plot 18 | , loglog, semilog, linlog, loglin 19 | , parametric 20 | -- * Formatting 21 | , title 22 | , subtitle 23 | -- | The following functions can 24 | -- be applied to a figure or a plot. 25 | -- When applied in 'Figure' context 26 | -- a single plot is assumed 27 | , Simple() 28 | , grid 29 | , xrange, yrange 30 | , xautorange, yautorange 31 | , xautorangeLog, yautorangeLog 32 | , xlabel, ylabel 33 | ) where 34 | 35 | ----------------------------------------------------------------------------- 36 | 37 | import Numeric.LinearAlgebra.Data 38 | 39 | import Graphics.Rendering.Plot.Figure 40 | 41 | ----------------------------------------------------------------------------- 42 | 43 | -- | create a figure with a single linear plot 44 | -- with lower X and Y axes whose ranges are set from the data 45 | plot :: Dataset d => d -> Figure () 46 | plot ds = do 47 | setPlots 1 1 48 | withPlot (1,1) $ do 49 | setDataset ds 50 | addAxis XAxis (Side Lower) $ return () 51 | addAxis YAxis (Side Lower) $ return () 52 | setRangeFromData XAxis Lower Linear 53 | setRangeFromData YAxis Lower Linear 54 | 55 | -- | create a figure with a single linear-log plot 56 | -- with lower X and Y axes whose ranges are set from the data 57 | semilog :: Dataset d => d -> Figure () 58 | semilog = linlog 59 | {-# DEPRECATED semilog "use linlog" #-} 60 | 61 | -- | create a figure with a single linear-log plot 62 | -- with lower X and Y axes whose ranges are set from the data 63 | linlog :: Dataset d => d -> Figure () 64 | linlog ds = do 65 | setPlots 1 1 66 | withPlot (1,1) $ do 67 | setDataset ds 68 | addAxis XAxis (Side Lower) $ return () 69 | addAxis YAxis (Side Lower) $ return () 70 | setRangeFromData XAxis Lower Linear 71 | setRangeFromData YAxis Lower Log 72 | 73 | -- | create a figure with a single log-linear plot 74 | -- with lower X and Y axes whose ranges are set from the data 75 | loglin :: Dataset d => d -> Figure () 76 | loglin ds = do 77 | setPlots 1 1 78 | withPlot (1,1) $ do 79 | setDataset ds 80 | addAxis XAxis (Side Lower) $ return () 81 | addAxis YAxis (Side Lower) $ return () 82 | setRangeFromData XAxis Lower Log 83 | setRangeFromData YAxis Lower Linear 84 | 85 | -- | create a figure with a single log-log plot 86 | -- with lower X and Y axes whose ranges are set from the data 87 | loglog :: Dataset d => d -> Figure () 88 | loglog ds = do 89 | setPlots 1 1 90 | withPlot (1,1) $ do 91 | setDataset ds 92 | addAxis XAxis (Side Lower) $ return () 93 | addAxis YAxis (Side Lower) $ return () 94 | setRangeFromData XAxis Lower Log 95 | setRangeFromData YAxis Lower Log 96 | 97 | -- | create a figure with a single parametric plot over n points 98 | -- with lower X and Y axes whose ranges are set from the data 99 | parametric :: (Double -> Double,Double -> Double) -> (Double,Double) -> Int -> Figure () 100 | parametric (fx,fy) (l,h) n = do 101 | setPlots 1 1 102 | withPlot (1,1) $ do 103 | let t = linspace n (l,h) 104 | setDataset (Line,cmap fx t,[cmap fy t]) 105 | addAxis XAxis (Side Lower) $ return () 106 | addAxis YAxis (Side Lower) $ return () 107 | setRangeFromData XAxis Lower Linear 108 | setRangeFromData YAxis Lower Linear 109 | 110 | ----------------------------------------------------------------------------- 111 | 112 | -- | set the title 113 | title :: String -> Figure () 114 | title s = withTitle $ setText s 115 | 116 | -- | set the subtitle 117 | subtitle :: String -> Figure () 118 | subtitle s = withSubTitle $ setText s 119 | 120 | ----------------------------------------------------------------------------- 121 | 122 | class Simple m where 123 | simple :: Plot () -> m () 124 | 125 | instance Simple Plot where 126 | simple m = m 127 | 128 | instance Simple Figure where 129 | simple m = withPlot (1,1) m 130 | 131 | -- | set the gridlines 132 | grid :: Simple m => Bool -> m () 133 | grid b = simple $ do 134 | withAxis XAxis (Side Lower) $ setGridlines Major b 135 | withAxis YAxis (Side Lower) $ setGridlines Major b 136 | 137 | -- | set the x range 138 | xrange :: Simple m => Scale -> Double -> Double -> m () 139 | xrange s l h = simple $ setRange XAxis Lower s l h 140 | 141 | -- | set the y range 142 | yrange :: Simple m => Scale -> Double -> Double -> m () 143 | yrange s l h = simple $ setRange YAxis Lower s l h 144 | 145 | -- | set the x range from data 146 | xautorange :: Simple m => m () 147 | xautorange = simple $ setRangeFromData XAxis Lower Linear 148 | 149 | -- | set the y range from data 150 | yautorange :: Simple m => m () 151 | yautorange = simple $ setRangeFromData YAxis Lower Linear 152 | 153 | -- | set the x range from data 154 | xautorangeLog :: Simple m => m () 155 | xautorangeLog = simple $ setRangeFromData XAxis Lower Log 156 | 157 | -- | set the y range from data 158 | yautorangeLog :: Simple m => m () 159 | yautorangeLog = simple $ setRangeFromData YAxis Lower Log 160 | 161 | -- | set the x label 162 | xlabel :: Simple m => String -> m () 163 | xlabel s = simple $ withAxis XAxis (Side Lower) $ withAxisLabel $ setText s 164 | 165 | -- | set the y label 166 | ylabel :: Simple m => String -> m () 167 | ylabel s = simple $ withAxis YAxis (Side Lower) $ withAxisLabel $ setText s 168 | 169 | ----------------------------------------------------------------------------- 170 | -------------------------------------------------------------------------------- /examples/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances #-} 2 | {-# LANGUAGE UnicodeSyntax #-} 3 | 4 | -- thanks to http://www.muitovar.com/gtk2hs/app1.html 5 | 6 | --module Test where 7 | 8 | import Control.Concurrent 9 | import Control.Concurrent.MVar 10 | 11 | import Control.Monad.Trans 12 | 13 | import Graphics.UI.Gtk hiding(Circle,Cross) 14 | import qualified Graphics.Rendering.Cairo as C 15 | import qualified Graphics.Rendering.Pango as P 16 | 17 | import Data.Colour.Names 18 | 19 | --import Prelude.Unicode 20 | 21 | import qualified Data.Array.IArray as A 22 | 23 | import Numeric.LinearAlgebra 24 | import Numeric.LinearAlgebra.Data 25 | 26 | import Numeric.GSL.Statistics 27 | 28 | import Graphics.Rendering.Plot 29 | 30 | import Debug.Trace 31 | 32 | ln = 25 33 | ts = linspace ln (0,1) 34 | 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] 35 | 36 | ss = sin (15*2*pi*ts) 37 | ds = 0.25*rs + ss 38 | es = konst (0.25*(stddev rs)) ln 39 | 40 | fs :: Double -> Double 41 | fs = sin . (15*2*pi*) 42 | 43 | ms :: Matrix Double 44 | ms = build (64,64) (\x y -> sin (2*2*pi*x/64) * cos (5*2*pi*y/64)) 45 | 46 | pts = linspace 1000 (0 :: Double,10*pi) 47 | fx = (\t -> t * sin t) pts 48 | fy = (\t -> t * cos t) pts 49 | 50 | hx = fromList [1,3,5,8,11,20,22,26] :: Vector Double 51 | hy = fromList [10,11,15,17,14,12,9] :: Vector Double 52 | 53 | lx = fromList [1,2,3,4,5,6,7,8,9,10] ∷ Vector Double 54 | ly = fromList [50000,10000,5000,1000,500,100,50,10,1] ∷ Vector Double 55 | 56 | mx = linspace 100 (1,10) ∷ Vector Double 57 | my = linspace 100 (1,10000) ∷ Vector Double 58 | 59 | cx = fromList [1,2,3,4,5] ∷ Vector Double 60 | cyl = fromList [8,10,12,13,8] ∷ Vector Double 61 | cyu = fromList [10,12,16,5,10] ∷ Vector Double 62 | cel = cyl - 1 63 | ceu = cyu + 1 64 | 65 | at = linspace 1000 (0,2*pi) ∷ Vector Double 66 | ax = sin at 67 | 68 | 69 | figure = do 70 | -- setPlots 1 1 71 | {- 72 | withPlot (1,1) $ do 73 | setDataset [(Hist,hx,hy)] 74 | addAxis XAxis (Side Lower) $ return () 75 | addAxis YAxis (Side Lower) $ return () 76 | -}{- setRange XAxis Lower (-4*pi) (1*pi) 77 | setRange YAxis Lower (-4*pi) (1*pi) -} 78 | {- setRange XAxis Lower 0 32 79 | setRange YAxis Lower 0 20 80 | -} 81 | withLineDefaults $ setLineWidth 2 82 | withTextDefaults $ setFontFamily "OpenSymbol" 83 | withTitle $ setText "Testing plot package:" 84 | withSubTitle $ do 85 | setText "with 1 second of a 15Hz sine wave" 86 | setFontSize 10 87 | setPlots 1 1 88 | 89 | withPlot (1,1) $ do 90 | 91 | -- setDataset (ts,[area ds blue]) 92 | -- setDataset (ts,[impulse fs blue]) 93 | -- setDataset (ts,[point (ds,es,"Sampled data") (Bullet,green) 94 | -- ,line (fs,"15 Hz sinusoid") blue]) 95 | -- setDataset [(Line,fx,fy)] 96 | -- setDataset (ts,[bar (ds,"Sampled data") (10 :: Double,green,3:: Double,blue) 97 | -- ,line (fs,"15 Hz sinusoid") blue]) 98 | -- setDataset [(Line,mx,my)] 99 | -- setDataset (Whisker,cx,[((cyl,cyu),(cel,ceu))]) 100 | setDataset (Line,at,[ax]) 101 | addAxis XAxis (Side Lower) $ do 102 | setGridlines Major True 103 | withAxisLabel $ setText "time (s)" 104 | addAxis YAxis (Side Lower) $ do 105 | setGridlines Major True 106 | withAxisLabel $ setText "amplitude (α)" 107 | -- addAxis XAxis (Value 0) $ return () 108 | setRangeFromData XAxis Lower Linear 109 | setRangeFromData YAxis Lower Linear 110 | withAnnotations $ do 111 | arrow True (pi/2,0.5) (0,0) (return ()) 112 | oval True (1.5,0) (pi,0.5) $ setBarColour blue 113 | rect True (0.5,0.5) (2,0.6) $ (return ()) 114 | glyph (4,0.2) (return ()) 115 | text (3,0.0) (setText "from the α to the Ω") 116 | cairo (\_ _ _ _ -> do 117 | --C.stroke 118 | --C.newPath 119 | C.moveTo 1 0.75 120 | C.lineTo 2 (-0.5) 121 | C.stroke 122 | --C.rectangle (pi/2) (-0.75) (pi/2) 1 123 | --C.fill 124 | ) 125 | -- setRange YAxis Lower Log (-1.25) 1.25 126 | -- setLegend True NorthEast Inside 127 | -- withLegendFormat $ setFontSize 6 128 | {- 129 | withPlot (1,1) $ do 130 | setDataset (ident 300 :: Matrix Double) --ms 131 | addAxis XAxis (Side Lower) $ setTickLabelFormat "%.0f" 132 | addAxis YAxis (Side Lower) $ setTickLabelFormat "%.0f" 133 | setRangeFromData XAxis Lower 134 | setRangeFromData YAxis Lower 135 | -} 136 | 137 | display :: ((Int,Int) -> C.Render ()) -> IO () 138 | display r = do 139 | initGUI -- is start 140 | 141 | window <- windowNew 142 | set window [ windowTitle := "Cairo test window" 143 | , windowDefaultWidth := 600 144 | , windowDefaultHeight := 400 145 | , containerBorderWidth := 1 146 | ] 147 | 148 | -- canvas <- pixbufNew ColorspaceRgb True 8 300 200 149 | -- containerAdd window canvas 150 | frame <- frameNew 151 | containerAdd window frame 152 | canvas <- drawingAreaNew 153 | containerAdd frame canvas 154 | widgetModifyBg canvas StateNormal (Color 65535 65535 65535) 155 | 156 | widgetShowAll window 157 | 158 | on canvas exposeEvent $ tryEvent $ do s <- liftIO $ widgetGetSize canvas 159 | drw <- liftIO $ widgetGetDrawWindow canvas 160 | --dat <- liftIO $ takeMVar d 161 | --liftIO $ renderWithDrawable drw (circle 50 10) 162 | liftIO $ renderWithDrawable drw (r s) 163 | 164 | onDestroy window mainQuit 165 | mainGUI 166 | 167 | 168 | main = display $ render figure 169 | 170 | test = writeFigure PDF "test.pdf" (400,400) figure 171 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Defaults.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot.Defaults 4 | -- Copyright : (c) A. V. H. McPhail 2010 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Default values 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot.Defaults where 16 | 17 | ----------------------------------------------------------------------------- 18 | 19 | import Data.Colour.Names 20 | 21 | import qualified Data.Array.IArray as A 22 | 23 | import qualified Graphics.Rendering.Pango as P 24 | 25 | import Graphics.Rendering.Plot.Figure.Text 26 | 27 | import Graphics.Rendering.Plot.Types 28 | 29 | ----------------------------------------------------------------------------- 30 | 31 | defaultXAxisSideLowerRange :: (Double,Double) 32 | defaultXAxisSideLowerRange = (-1,1) 33 | 34 | ----------------------------------------------------------------------------- 35 | 36 | defaultColourList :: [Color] 37 | defaultColourList = [blue,red,green,yellow,violet,sienna,royalblue 38 | ,pink,tomato,lavender,cyan,crimson,darkgreen 39 | ,cadetblue,darkred,yellowgreen] 40 | ++ defaultColourList 41 | 42 | ----------------------------------------------------------------------------- 43 | 44 | defaultGlyphList :: [Glyph] 45 | defaultGlyphList = [Box, Diamond, Asterisk, Triangle, Circle] 46 | ++ defaultGlyphList 47 | 48 | ----------------------------------------------------------------------------- 49 | 50 | defaultPointOptions :: PointOptions 51 | defaultPointOptions = PointOptions 1 black 52 | 53 | defaultGlyph :: Glyph 54 | defaultGlyph = Circle 55 | 56 | defaultPointType :: PointType 57 | defaultPointType = FullPoint defaultPointOptions defaultGlyph 58 | 59 | ----------------------------------------------------------------------------- 60 | 61 | defaultDashStyle :: DashStyle 62 | defaultDashStyle = [] 63 | 64 | defaultLineWidth :: LineWidth 65 | defaultLineWidth = 1 66 | 67 | defaultLineOptions :: LineOptions 68 | defaultLineOptions = LineOptions defaultDashStyle defaultLineWidth 69 | 70 | defaultLineType :: LineType 71 | defaultLineType = ColourLine black 72 | 73 | defaultGridLine :: LineType 74 | defaultGridLine = ColourLine grey 75 | 76 | ----------------------------------------------------------------------------- 77 | 78 | defaultFigureBackgroundColour :: Color 79 | defaultFigureBackgroundColour = white 80 | 81 | defaultFigureForegroundColour :: Color 82 | defaultFigureForegroundColour = black 83 | 84 | defaultPlotBackgroundColour :: Color 85 | defaultPlotBackgroundColour = white 86 | 87 | ----------------------------------------------------------------------------- 88 | 89 | defaultBarWidth :: Double 90 | defaultBarWidth = 5 91 | 92 | defaultBarBorderWidth :: Double 93 | defaultBarBorderWidth = 1 94 | 95 | defaultBarBorderColour :: Color 96 | defaultBarBorderColour = black 97 | 98 | defaultBarOptions :: BarOptions 99 | defaultBarOptions = BarOptions defaultBarWidth defaultBarBorderWidth defaultBarBorderColour 100 | 101 | defaultBarType :: BarType 102 | defaultBarType = ColourBar red 103 | 104 | ----------------------------------------------------------------------------- 105 | 106 | defaultFontFamily :: FontFamily 107 | defaultFontFamily = "Sans" 108 | 109 | defaultFontStyle :: P.FontStyle 110 | defaultFontStyle = P.StyleNormal 111 | 112 | defaultFontVariant :: P.Variant 113 | defaultFontVariant = P.VariantNormal 114 | 115 | defaultFontWeight :: P.Weight 116 | defaultFontWeight = P.WeightNormal 117 | 118 | defaultFontStretch :: P.Stretch 119 | defaultFontStretch = P.StretchNormal 120 | 121 | defaultFontOptions :: FontOptions 122 | defaultFontOptions = FontOptions defaultFontFamily defaultFontStyle defaultFontVariant 123 | defaultFontWeight defaultFontStretch 124 | 125 | defaultFontSize :: Double 126 | defaultFontSize = 16 127 | 128 | defaultFontColour :: Color 129 | defaultFontColour = black 130 | 131 | defaultTextOptions :: TextOptions 132 | defaultTextOptions = TextOptions defaultFontOptions defaultFontSize defaultFontColour 133 | 134 | ----------------------------------------------------------------------------- 135 | 136 | defaultBounding :: BoundingBox 137 | defaultBounding = BoundingBox 0 0 1 1 138 | 139 | ----------------------------------------------------------------------------- 140 | 141 | defaultRanges :: Double -> Double -> Double -> Double -> Ranges 142 | defaultRanges xmin xmax ymin ymax = Ranges (Left (Range Linear xmin xmax)) (Left (Range Linear ymin ymax)) 143 | 144 | ----------------------------------------------------------------------------- 145 | 146 | zeroPadding, defaultPadding, defaultFigurePadding, defaultPlotPadding :: Padding 147 | zeroPadding = Padding 0 0 0 0 148 | defaultPadding = Padding 10 10 10 10 149 | defaultFigurePadding = Padding 10 10 10 10 150 | defaultPlotPadding = Padding 10 10 10 10 151 | 152 | ----------------------------------------------------------------------------- 153 | 154 | solid, empty :: Solid 155 | solid = True 156 | empty = False 157 | 158 | ----------------------------------------------------------------------------- 159 | 160 | defaultOptions :: Options 161 | defaultOptions = Options defaultLineOptions 162 | defaultPointOptions 163 | defaultBarOptions 164 | defaultTextOptions 165 | 166 | ----------------------------------------------------------------------------- 167 | 168 | minorTickLength, majorTickLength, tickLabelScale :: Double 169 | minorTickLength = 5.0 170 | majorTickLength = 7.0 171 | tickLabelScale = 0.75 172 | 173 | defaultMinorTicks :: Maybe Ticks 174 | defaultMinorTicks = Just $ Ticks NoLine (TickNumber 41) 175 | 176 | defaultMajorTicks :: Maybe Ticks 177 | defaultMajorTicks = Just $ Ticks NoLine (TickNumber 5) 178 | 179 | defaultTickFormat :: TickFormat 180 | defaultTickFormat = DefaultTickFormat 181 | 182 | defaultAxis :: AxisType -> AxisPosn -> AxisData 183 | defaultAxis at axp = Axis at axp 184 | defaultLineType defaultMinorTicks defaultMajorTicks 185 | defaultTickFormat 186 | [] NoText 187 | 188 | defaultXAxis, defaultYAxis :: AxisData 189 | defaultXAxis = defaultAxis XAxis (Side Lower) 190 | defaultYAxis = defaultAxis YAxis (Side Lower) 191 | 192 | ----------------------------------------------------------------------------- 193 | 194 | defaultLegend :: LegendData 195 | defaultLegend = Legend True East Outside (scaleFontSize legendLabelScale defaultTextOptions) 196 | 197 | legendLabelScale :: Double 198 | legendLabelScale = 0.7 199 | 200 | legendSampleWidth :: Double 201 | legendSampleWidth = 10 202 | 203 | ----------------------------------------------------------------------------- 204 | 205 | defaultSupply :: SupplyData 206 | defaultSupply = SupplyData defaultColourList defaultGlyphList 207 | 208 | ----------------------------------------------------------------------------- 209 | 210 | emptyPlot :: PlotData 211 | emptyPlot = Plot False defaultPlotBackgroundColour defaultPlotPadding NoText (Ranges (Left (Range Linear (-1) 1)) (Left (Range Linear (-1) 1))) 212 | [] BarSpread True undefined Nothing [] 213 | 214 | ----------------------------------------------------------------------------- 215 | 216 | emptyPlots :: Plots 217 | emptyPlots = (A.listArray ((0,0),(0,0)) []) 218 | 219 | ----------------------------------------------------------------------------- 220 | 221 | emptyFigure :: FigureData 222 | emptyFigure = Figure defaultFigureBackgroundColour defaultFigurePadding NoText NoText emptyPlots 223 | 224 | ----------------------------------------------------------------------------- 225 | 226 | defaultFigureState :: FigureState 227 | defaultFigureState = FigureState undefined 228 | defaultSupply 229 | undefined 230 | 231 | ----------------------------------------------------------------------------- 232 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Render/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Graphics.Rendering.Plot.Render.Types 5 | -- Copyright : (c) A. V. H. McPhail 2010 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : haskell.vivian.mcphail gmail com 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Rendering 'Figure's 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Graphics.Rendering.Plot.Render.Types where 17 | 18 | ----------------------------------------------------------------------------- 19 | 20 | --import Data.Either 21 | 22 | --import Data.Packed.Vector 23 | --import Numeric.LinearAlgebra.Linear 24 | 25 | --import Data.Word 26 | 27 | import Data.Maybe 28 | 29 | import Data.Colour.SRGB 30 | import Data.Colour.Names 31 | 32 | --import qualified Data.Array.IArray as A 33 | 34 | import qualified Graphics.Rendering.Cairo as C 35 | import qualified Graphics.Rendering.Cairo.Matrix as CM 36 | import qualified Graphics.Rendering.Pango as P 37 | 38 | #if !(MIN_VERSION_base(4,8,0)) 39 | import Control.Applicative 40 | #endif 41 | import Control.Monad.Reader 42 | import Control.Monad.State 43 | --import Control.Monad.Trans 44 | 45 | import Graphics.Rendering.Plot.Types 46 | import Graphics.Rendering.Plot.Defaults 47 | 48 | --import Graphics.Rendering.Plot.Figure.Text 49 | 50 | --import qualified Text.Printf as Printf 51 | 52 | --import Prelude hiding(min,max) 53 | --import qualified Prelude(max) 54 | 55 | ----------------------------------------------------------------------------- 56 | {- 57 | newtype Render a = FR { runRender :: StateT BoundingBox C.Render a } 58 | deriving(Monad, Functor, Applicative, MonadState BoundingBox, MonadTrans (StateT BoundingBox)) 59 | -} 60 | 61 | data RenderEnv = RenderEnv { 62 | _pangocontext :: P.PangoContext 63 | , _renderoptions :: Options 64 | } 65 | 66 | newtype BoundedT m a = BT { runRender :: ReaderT RenderEnv (StateT BoundingBox m) a } 67 | deriving(Monad, Functor, Applicative, MonadState BoundingBox, MonadReader RenderEnv) 68 | 69 | instance MonadTrans BoundedT where 70 | lift m = BT $ lift $ lift m 71 | 72 | type Render = BoundedT C.Render 73 | 74 | evalRender :: Render a -> RenderEnv -> BoundingBox -> C.Render a 75 | evalRender m r = evalStateT (runReaderT (runRender m) r) 76 | 77 | ----------------------------------------------------------------------------- 78 | 79 | cairo :: C.Render a -> Render a 80 | cairo = lift 81 | 82 | pango :: IO a -> C.Render a 83 | pango = liftIO 84 | 85 | ----------------------------------------------------------------------------- 86 | 87 | bbX, bbY, bbW, bbH :: Render Double 88 | bbX = gets _bbX 89 | bbY = gets _bbY 90 | bbW = gets _bbW 91 | bbH = gets _bbH 92 | 93 | bbLeftWidth, bbCentreWidth, bbRightWidth, bbBottomHeight, bbCentreHeight, bbTopHeight :: Render Double 94 | bbLeftWidth = gets $ \(BoundingBox x _ _ _) -> x 95 | bbCentreWidth = gets $ \(BoundingBox x _ w _) -> x + w / 2 96 | bbRightWidth = gets $ \(BoundingBox x _ w _) -> x + w 97 | bbBottomHeight = gets $ \(BoundingBox _ y _ h) -> y + h 98 | bbCentreHeight = gets $ \(BoundingBox _ y _ h) -> y + h / 2 99 | bbTopHeight = gets $ \(BoundingBox _ y _ _) -> y 100 | 101 | bbShiftLeft, bbShiftRight, bbLowerTop, bbRaiseBottom :: Double -> Render () 102 | bbShiftLeft n = modify $ \(BoundingBox x y w h) -> 103 | BoundingBox (x+n) y (w-n) h 104 | bbShiftRight n = modify $ \(BoundingBox x y w h) -> 105 | BoundingBox x y (w-n) h 106 | bbLowerTop n = modify $ \(BoundingBox x y w h) -> 107 | BoundingBox x (y+n) w (h-n) 108 | bbRaiseBottom n = modify $ \(BoundingBox x y w h) -> 109 | BoundingBox x y w (h-n) 110 | 111 | applyPads :: Padding -> Render () 112 | applyPads (Padding l r b t) = modify (\(BoundingBox x y w h) -> 113 | BoundingBox (x+l) (y+t) (w-l-r) (h-t-b)) 114 | 115 | ----------------------------------------------------------------------------- 116 | 117 | clipBoundary :: Render () 118 | clipBoundary = do 119 | (BoundingBox x y w h) <- get 120 | cairo $ do 121 | C.rectangle x y w h 122 | C.clip 123 | 124 | ----------------------------------------------------------------------------- 125 | 126 | -- | output file type 127 | data OutputType = PNG | PS | PDF | SVG 128 | 129 | ----------------------------------------------------------------------------- 130 | 131 | setColour :: Color -> C.Render () 132 | setColour c = let (RGB r g b) = toSRGB c 133 | in C.setSourceRGBA r g b 1 -- no transparent colours 134 | 135 | 136 | setDashes :: [Dash] -> C.Render () 137 | setDashes [] = C.setDash [] 0 138 | setDashes xs = do 139 | let xs' = map (\d -> case d of { Dot -> 1 ; Dash -> 3 }) xs 140 | C.setDash xs' 0 141 | 142 | ----------------------------------------------------------------------------- 143 | 144 | getDefaultTextOptions :: P.PangoContext -> IO TextOptions 145 | getDefaultTextOptions pc = do 146 | fd <- P.contextGetFontDescription pc 147 | getTextOptionsFD fd 148 | 149 | getTextOptionsFD :: P.FontDescription -> IO TextOptions 150 | getTextOptionsFD fd = do 151 | ff' <- P.fontDescriptionGetFamily fd 152 | fs' <- P.fontDescriptionGetStyle fd 153 | fv' <- P.fontDescriptionGetVariant fd 154 | fw' <- P.fontDescriptionGetWeight fd 155 | fc' <- P.fontDescriptionGetStretch fd 156 | fz' <- P.fontDescriptionGetSize fd 157 | let ff = fromMaybe defaultFontFamily ff' 158 | fs = fromMaybe defaultFontStyle fs' 159 | fv = fromMaybe defaultFontVariant fv' 160 | fw = fromMaybe defaultFontWeight fw' 161 | fc = fromMaybe defaultFontStretch fc' 162 | fz = fromMaybe defaultFontSize fz' 163 | return $ TextOptions (FontOptions ff fs fv fw fc) fz black 164 | 165 | setTextOptions :: TextOptions -> P.PangoLayout -> C.Render () 166 | setTextOptions to lo = do 167 | fd' <- pango $ P.layoutGetFontDescription lo 168 | fd <- case fd' of 169 | Nothing -> pango $ P.fontDescriptionNew 170 | Just fd'' -> return fd'' 171 | setTextOptionsFD to fd 172 | pango $ P.layoutSetFontDescription lo (Just fd) 173 | 174 | setTextOptionsFD :: TextOptions -> P.FontDescription -> C.Render () 175 | setTextOptionsFD (TextOptions (FontOptions ff fs fv fw fc) fz c) fd = do 176 | pango $ do 177 | P.fontDescriptionSetFamily fd ff 178 | P.fontDescriptionSetStyle fd fs 179 | P.fontDescriptionSetVariant fd fv 180 | P.fontDescriptionSetWeight fd fw 181 | P.fontDescriptionSetStretch fd fc 182 | P.fontDescriptionSetSize fd fz 183 | setColour c 184 | 185 | ----------------------------------------------------------------------------- 186 | 187 | textPad :: Double 188 | textPad = 2 189 | 190 | data TextXAlign = TLeft | Centre | TRight 191 | data TextYAlign = TBottom | Middle | TTop 192 | 193 | ----------------------------------------------------------------------------- 194 | 195 | setLineOptions :: LineOptions -> C.Render () 196 | setLineOptions (LineOptions ds lw) = do 197 | setDashes ds 198 | C.setLineWidth lw 199 | 200 | setLineStyle :: LineType -> C.Render () 201 | setLineStyle NoLine = return () 202 | setLineStyle (ColourLine c) = setColour c 203 | setLineStyle (TypeLine lo c) = do 204 | setLineOptions lo 205 | setColour c 206 | 207 | ----------------------------------------------------------------------------- 208 | 209 | setPointOptions :: PointOptions -> C.Render () 210 | setPointOptions (PointOptions pz c) = do 211 | setColour c 212 | C.scale pz pz 213 | 214 | setPointStyle :: PointType -> C.Render Glyph 215 | setPointStyle (FullPoint po g) = do 216 | setPointOptions po 217 | return g 218 | 219 | ----------------------------------------------------------------------------- 220 | 221 | flipVerticalMatrix :: CM.Matrix 222 | flipVerticalMatrix = CM.Matrix 1 0 0 (-1) 0 0 223 | 224 | flipVertical :: C.Render () 225 | flipVertical = C.transform flipVerticalMatrix 226 | 227 | ----------------------------------------------------------------------------- 228 | 229 | 230 | 231 | 232 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Text.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot.Figure.Text 4 | -- Copyright : (c) A. V. H. McPhail 2010 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- 'Text' operations 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot.Figure.Text ( 16 | Text 17 | , FontFamily,FontSize,Color 18 | -- | A text element must exist for formatting to work 19 | , clearText 20 | , clearTextFormat 21 | , setText 22 | , setFontFamily 23 | , setFontStyle 24 | , setFontVariant 25 | , setFontWeight 26 | , setFontStretch 27 | , setFontSize 28 | , setFontColour 29 | -- 30 | , changeFontSize 31 | , changeFontColour 32 | -- 33 | , scaleFontSize 34 | ) where 35 | 36 | ----------------------------------------------------------------------------- 37 | 38 | import Control.Monad.State 39 | import Control.Monad.Reader 40 | 41 | import qualified Graphics.Rendering.Pango as P 42 | 43 | import Graphics.Rendering.Plot.Types 44 | 45 | ----------------------------------------------------------------------------- 46 | 47 | changeFontFamilyFont :: FontFamily -> FontOptions -> FontOptions 48 | changeFontFamilyFont ff (FontOptions _ fs fv fw fc) = FontOptions ff fs fv fw fc 49 | 50 | changeFontStyleFont :: P.FontStyle -> FontOptions -> FontOptions 51 | changeFontStyleFont fs (FontOptions ff _ fv fw fc) = FontOptions ff fs fv fw fc 52 | 53 | changeFontVariantFont :: P.Variant -> FontOptions -> FontOptions 54 | changeFontVariantFont fv (FontOptions ff fs _ fw fc) = FontOptions ff fs fv fw fc 55 | 56 | changeFontWeightFont :: P.Weight -> FontOptions -> FontOptions 57 | changeFontWeightFont fw (FontOptions ff fs fv _ fc) = FontOptions ff fs fv fw fc 58 | 59 | changeFontStretchFont :: P.Stretch -> FontOptions -> FontOptions 60 | changeFontStretchFont fc (FontOptions ff fs fv fw _) = FontOptions ff fs fv fw fc 61 | 62 | changeFontOptionsFont :: (FontOptions -> FontOptions) -> TextOptions -> TextOptions 63 | changeFontOptionsFont f (TextOptions fo fz c) = TextOptions (f fo) fz c 64 | 65 | changeFontFamily :: FontFamily -> TextOptions -> TextOptions 66 | changeFontFamily ff = changeFontOptionsFont $ changeFontFamilyFont ff 67 | 68 | changeFontStyle :: P.FontStyle -> TextOptions -> TextOptions 69 | changeFontStyle fs = changeFontOptionsFont $ changeFontStyleFont fs 70 | 71 | changeFontVariant :: P.Variant -> TextOptions -> TextOptions 72 | changeFontVariant fv = changeFontOptionsFont $ changeFontVariantFont fv 73 | 74 | changeFontWeight :: P.Weight -> TextOptions -> TextOptions 75 | changeFontWeight fw = changeFontOptionsFont $ changeFontWeightFont fw 76 | 77 | changeFontStretch :: P.Stretch -> TextOptions -> TextOptions 78 | changeFontStretch fc = changeFontOptionsFont $ changeFontStretchFont fc 79 | 80 | changeFontSize :: FontSize -> TextOptions -> TextOptions 81 | changeFontSize fz (TextOptions fo _ c) = TextOptions fo fz c 82 | 83 | scaleFontSize :: Double -> TextOptions -> TextOptions 84 | scaleFontSize sc (TextOptions fo fz c) = TextOptions fo (sc*fz) c 85 | 86 | changeFontColour :: Color -> TextOptions -> TextOptions 87 | changeFontColour c (TextOptions fo fz _) = TextOptions fo fz c 88 | 89 | changeFontTextSize :: FontSize -> TextEntry -> TextEntry 90 | changeFontTextSize fz (FontText to s) = FontText (changeFontSize fz to) s 91 | changeFontTextSize _ _ = error "changeFontTextSize" 92 | 93 | changeFontTextColour :: Color -> TextEntry -> TextEntry 94 | changeFontTextColour c (FontText to s) = FontText (changeFontColour c to) s 95 | changeFontTextColour _ _ = error "changeFontTextColour" 96 | 97 | changeText :: String -> TextEntry -> TextEntry 98 | changeText s NoText = BareText s 99 | changeText s (BareText _) = BareText s 100 | changeText s (SizeText fz c _) = SizeText fz c s 101 | changeText s (FontText to _) = FontText to s 102 | 103 | clearTextEntryFormat :: TextEntry -> TextEntry 104 | clearTextEntryFormat NoText = NoText 105 | clearTextEntryFormat t@(BareText _) = t 106 | clearTextEntryFormat (SizeText _ _ s) = BareText s 107 | clearTextEntryFormat (FontText _ s) = BareText s 108 | 109 | ----------------------------------------------------------------------------- 110 | 111 | -- | clear the text entry 112 | clearText :: Text () 113 | clearText = put NoText 114 | 115 | -- | set the text formatting to the default 116 | clearTextFormat :: Text () 117 | clearTextFormat = modify clearTextEntryFormat 118 | 119 | -- | set the value of a text entry 120 | setText :: String -> Text () 121 | setText l = modify (changeText l) 122 | 123 | changeFontOptions :: (TextOptions -> TextOptions) -> TextEntry -> Text () 124 | changeFontOptions _ NoText = return () 125 | changeFontOptions o (BareText s) = do 126 | to <- ask 127 | put $ FontText (o to) s 128 | changeFontOptions o (SizeText fz c s) = do 129 | to <- ask 130 | let (TextOptions fo _ _) = o to 131 | put $ FontText (TextOptions fo fz c) s 132 | changeFontOptions o (FontText to s) = put $ FontText (o to) s 133 | 134 | 135 | -- | set the font style of a text entry 136 | setFontFamily :: FontFamily -> Text () 137 | setFontFamily ff = get >>= changeFontOptions (changeFontFamily ff) 138 | 139 | -- | set the font style of a text entry 140 | setFontStyle :: P.FontStyle -> Text () 141 | setFontStyle fs = get >>= changeFontOptions (changeFontStyle fs) 142 | 143 | -- | set the font variant of a text entry 144 | setFontVariant :: P.Variant -> Text () 145 | setFontVariant fv = get >>= changeFontOptions (changeFontVariant fv) 146 | 147 | -- | set the font weight of a text entry 148 | setFontWeight :: P.Weight -> Text () 149 | setFontWeight fw = get >>= changeFontOptions (changeFontWeight fw) 150 | 151 | -- | set the font stretch of a text entry 152 | setFontStretch :: P.Stretch -> Text () 153 | setFontStretch fc = get >>= changeFontOptions (changeFontStretch fc) 154 | 155 | -- | set the font size of a text entry 156 | setFontSize :: FontSize -> Text () 157 | setFontSize fz = do 158 | t <- get 159 | case t of 160 | NoText -> return () 161 | (BareText s) -> do 162 | (TextOptions _ _ c) <- ask 163 | put $ SizeText fz c s 164 | (SizeText _ c s) -> put $ SizeText fz c s 165 | (FontText to s) -> put $ FontText (changeFontSize fz to) s 166 | 167 | -- | set the colour of a text entry 168 | setFontColour :: Color -> Text () 169 | setFontColour c = do 170 | t <- get 171 | case t of 172 | NoText -> return () 173 | (BareText s) -> do 174 | (TextOptions _ fz _) <- ask 175 | put $ SizeText fz c s 176 | (SizeText fz _ s) -> put $ SizeText fz c s 177 | (FontText to s) -> put $ FontText (changeFontColour c to) s 178 | 179 | ----------------------------------------------------------------------------- 180 | 181 | 182 | -------------------------------------------------------------------------------- /examples/Test2.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverlappingInstances #-} 2 | {-# LANGUAGE UnicodeSyntax #-} 3 | 4 | -- thanks to http://www.muitovar.com/gtk2hs/app1.html 5 | 6 | --module Test where 7 | 8 | import Control.Concurrent 9 | import Control.Concurrent.MVar 10 | 11 | import Control.Monad.Trans 12 | 13 | import Graphics.UI.Gtk hiding(Circle,Cross) 14 | import qualified Graphics.Rendering.Cairo as C 15 | import qualified Graphics.Rendering.Pango as P 16 | 17 | import Data.Colour.Names 18 | 19 | import Data.Packed.Vector 20 | --import Data.Packed.Random 21 | import Data.Packed() 22 | 23 | --import Prelude.Unicode 24 | 25 | import qualified Data.Array.IArray as A 26 | 27 | import Numeric.LinearAlgebra 28 | 29 | import Numeric.GSL.Statistics 30 | 31 | import Graphics.Rendering.Plot 32 | 33 | import Debug.Trace 34 | 35 | ln = 25 36 | ts = linspace ln (0,1) 37 | 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] 38 | 39 | ut = linspace 25 (1::Double,100) 40 | 41 | ss = sin (15*2*pi*ts) 42 | ds = 0.25*rs + ss 43 | es = constant (0.25*(stddev rs)) ln 44 | gs = 0.40*rs - 1 45 | fs :: Double -> Double 46 | fs = sin . (15*2*pi*) 47 | 48 | ms :: Matrix Double 49 | ms = buildMatrix 64 64 (\(x,y) -> sin (2*2*pi*(fromIntegral x)/64) * cos (5*2*pi*(fromIntegral y)/64)) 50 | 51 | pts = linspace 1000 (0 :: Double,10*pi) 52 | fx = (\t -> t * sin t) pts 53 | fy = (\t -> t * cos t) pts 54 | 55 | hx = fromList [1,3,5,8,11,20,22,26,12,10,4] :: Vector Double 56 | hy = fromList [10,11,15,17,14,12,9,11,16,4,6] :: Vector Double 57 | he = fromList [11,13,16,19,16,14,19,7,10,5,3] :: Vector Double 58 | 59 | lx = fromList [1,2,3,4,5,6,7,8,9,10] ∷ Vector Double 60 | ly = fromList [50000,10000,5000,1000,500,100,50,10,1] ∷ Vector Double 61 | 62 | mx = linspace 100 (1,10) ∷ Vector Double 63 | my = linspace 100 (1,10000) ∷ Vector Double 64 | 65 | rx = scaleRecip 1 mx 66 | 67 | cx = fromList [1,2,3,4,5] ∷ Vector Double 68 | cyl = fromList [8,10,12,13,8] ∷ Vector Double 69 | cyu = fromList [10,12,16,11,10] ∷ Vector Double 70 | cel = cyl - 1 71 | ceu = cyu + 1 72 | 73 | at = linspace 1000 (0,2*pi) ∷ Vector Double 74 | ax = sin at 75 | 76 | 77 | figure = do 78 | -- setPlots 1 1 79 | {- 80 | withPlot (1,1) $ do 81 | setDataset [(Hist,hx,hy)] 82 | addAxis XAxis (Side Lower) $ return () 83 | addAxis YAxis (Side Lower) $ return () 84 | -}{- setRange XAxis Lower (-4*pi) (1*pi) 85 | setRange YAxis Lower (-4*pi) (1*pi) -} 86 | {- setRange XAxis Lower 0 32 87 | setRange YAxis Lower 0 20 88 | -} 89 | --withLineDefaults $ setLineWidth 2 90 | withTextDefaults $ setFontFamily "OpenSymbol" 91 | withTitle $ setText "Testing plot package:" 92 | {- withSubTitle $ do 93 | setText "with 1 second of a 15Hz sine wave" 94 | setFontSize 10 95 | -} 96 | setPlots 1 1 97 | 98 | withPlot (1,1) $ do 99 | -- setDataset (Bar, lx, [hx,hy,he]) 100 | -- barSetting BarStack 101 | -- setDataset (Line, mx, [rx]) 102 | -- setDataset (Line, ts, [ds]) 103 | sampleData False 104 | setDataset (ts,[line ds red]) 105 | -- setDataset (ts,[impulse fs blue]) 106 | -- setDataset (ts,[point (ds,es,"Sampled data") (Bullet,green) 107 | -- setDataset (ts,[bar (ds,ds+es,"Sampled data") green 108 | -- ,line (fs,"15 Hz sinusoid") blue]) 109 | -- setDataset [(Line,fx,fy)] 110 | -- setDataset ([bar (ds,es,"Sampled data") green 111 | -- ,bar (gs,"Modified sample data") blue]) 112 | -- setDataset (ts,[bar (ds,"Sampled data") green 113 | -- ,line (fs,"15 Hz sinusoid") blue]) 114 | -- setDataset [(Line,mx,my)] 115 | -- setDataset (Whisker,cx,[((cyl,cyu),(cel,ceu))]) 116 | -- withAllSeriesFormats (\_ -> do 117 | -- setBarWidth 0.5 118 | -- setBarBorderWidth 0.1) 119 | -- setDataset (Hist,hx,[(hy,he)]) 120 | addAxis XAxis (Side Lower) $ do 121 | -- setGridlines Major True 122 | withAxisLabel $ setText "time (s)" 123 | --setTicks Major (TickValues $ fromList [1,2,5,10]) 124 | setTicks Major (TickNumber 12) 125 | setTicks Minor (TickNumber 100) 126 | setTickLabelFormat $ Printf "%.2f" 127 | --setTickLabels ["Jan","Feb","Mar","Apr","May"] 128 | --withTickLabelFormat $ setFontSize 8 129 | addAxis YAxis (Side Lower) $ do 130 | -- setGridlines Major True 131 | withAxisLabel $ setText "amplitude (α)" 132 | setTicks Minor (TickNumber 0) 133 | -- addAxis XAxis (Value 0) $ return () 134 | setRangeFromData XAxis Lower Linear 135 | setRangeFromData YAxis Lower Linear 136 | -- setRange XAxis Lower Linear 0 11 137 | {- withAnnotations $ do 138 | arrow True (pi/2,0.5) (0,0) (return ()) 139 | --oval True (0.5,1) (1,3) $ setBarColour blue 140 | rect True (0.5,0.5) (2,0.75) $ (return ()) 141 | glyph (4,0.2) (return ()) 142 | text (3,0.0) (setText "from the α to the Ω") 143 | cairo (\_ _ _ _ -> do 144 | C.moveTo 3 0.75 145 | C.lineTo 4 (-0.5) 146 | C.stroke 147 | ) 148 | -} 149 | -- setRange YAxis Lower Log (-1.25) 1.25 150 | -- setLegend True NorthEast Inside 151 | -- withLegendFormat $ setFontSize 6 152 | {- 153 | withPlot (1,1) $ do 154 | setDataset (ident 300 :: Matrix Double) --ms 155 | addAxis XAxis (Side Lower) $ setTickLabelFormat "%.0f" 156 | addAxis YAxis (Side Lower) $ setTickLabelFormat "%.0f" 157 | setRangeFromData XAxis Lower 158 | setRangeFromData YAxis Lower 159 | -} 160 | 161 | display :: ((Int,Int) -> C.Render ()) -> IO () 162 | display r = do 163 | initGUI -- is start 164 | 165 | window <- windowNew 166 | set window [ windowTitle := "Cairo test window" 167 | , windowDefaultWidth := 600 168 | , windowDefaultHeight := 400 169 | , containerBorderWidth := 1 170 | ] 171 | 172 | -- canvas <- pixbufNew ColorspaceRgb True 8 300 200 173 | -- containerAdd window canvas 174 | frame <- frameNew 175 | containerAdd window frame 176 | canvas <- drawingAreaNew 177 | containerAdd frame canvas 178 | widgetModifyBg canvas StateNormal (Color 65535 65535 65535) 179 | 180 | widgetShowAll window 181 | 182 | on canvas exposeEvent $ tryEvent $ do 183 | s <- liftIO $ widgetGetSize canvas 184 | drw <- liftIO $ widgetGetDrawWindow canvas 185 | --dat <- liftIO $ takeMVar d 186 | --liftIO $ renderWithDrawable drw (circle 50 10) 187 | liftIO $ renderWithDrawable drw (r s) 188 | 189 | onDestroy window mainQuit 190 | mainGUI 191 | 192 | 193 | main = display $ render figure 194 | 195 | test = writeFigure PDF "test.pdf" (400,400) figure -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Graphics.Rendering.Plot.Render.Plot.Legend 5 | -- Copyright : (c) A. V. H. McPhail 2010 6 | -- License : BSD3 7 | -- 8 | -- Maintainer : haskell.vivian.mcphail gmail com 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Rendering 'Figure's 13 | -- 14 | ----------------------------------------------------------------------------- 15 | 16 | module Graphics.Rendering.Plot.Render.Plot.Legend ( 17 | -- * Rendering 18 | renderLegend 19 | ) where 20 | 21 | ----------------------------------------------------------------------------- 22 | 23 | import Data.List(maximumBy) 24 | 25 | import Data.Colour.Names 26 | 27 | import qualified Data.Array.IArray as A 28 | import qualified Graphics.Rendering.Cairo as C 29 | import qualified Graphics.Rendering.Pango as P 30 | 31 | import Control.Monad.Reader 32 | 33 | import Graphics.Rendering.Plot.Types 34 | import Graphics.Rendering.Plot.Defaults 35 | 36 | import Graphics.Rendering.Plot.Render.Types 37 | import Graphics.Rendering.Plot.Render.Text 38 | import Graphics.Rendering.Plot.Render.Plot.Glyph 39 | 40 | --import qualified Text.Printf as Printf 41 | 42 | --import Prelude hiding(min,max) 43 | --import qualified Prelude(max) 44 | 45 | #if MIN_VERSION_mtl(2,3,0) 46 | import Control.Monad 47 | #endif 48 | 49 | ----------------------------------------------------------------------------- 50 | 51 | renderLegend :: Maybe LegendData -> DataSeries -> Render (Padding -> Render ()) 52 | renderLegend Nothing _ = return $ \_ -> return () 53 | renderLegend (Just (Legend b l o to)) d = do 54 | -- calculate row height and max length 55 | let (ln,ls) = getLabels d 56 | mx = maximumBy (\ x y -> length x `compare` length y) $ fst $ unzip ls 57 | pc <- asks _pangocontext 58 | (w,h) <- cairo $ do 59 | lo <- pango $ P.layoutText pc mx 60 | setTextOptions to lo 61 | (_,twh) <- textSize lo Centre Middle 0 0 62 | return twh 63 | -- if outside shift bounding box 64 | case o of 65 | -- render legend 66 | Outside -> do 67 | outside <- renderLegendOutside b l w h to ln ls 68 | return outside 69 | -- else return (render legend) 70 | Inside -> return $ \_ -> renderLegendInside b l w h to ln ls 71 | 72 | renderLegendOutside :: Bool -> LegendLocation -> Double -> Double -> TextOptions -> Int -> [(SeriesLabel,Decoration)] -> Render (Padding -> Render ()) 73 | renderLegendOutside b l w h to ln ls 74 | | l == North = do 75 | let h' = textPad + h + textPad 76 | bbLowerTop $ h' + 4*textPad 77 | return $ \(Padding _ _ _ t) -> do 78 | x' <- bbCentreWidth 79 | y' <- bbTopHeight 80 | let w' = (fromIntegral ln)*(textPad + legendSampleWidth 81 | + legendSampleWidth + textPad + w) + 5*textPad 82 | let x = x'- (w'/2) 83 | y = y'- h' - t 84 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h') 85 | renderLegendEntries (x+3*textPad) (y+textPad) 86 | (textPad + legendSampleWidth + legendSampleWidth + textPad 87 | + w + textPad) 0 0 h to ls 88 | return () 89 | | l == NorthEast = do 90 | let h' = textPad + h + textPad 91 | bbLowerTop $ h' + 4*textPad 92 | return $ \(Padding _ _ _ t) -> do 93 | x' <- bbRightWidth 94 | y' <- bbTopHeight 95 | let w' = (fromIntegral ln)*(textPad + legendSampleWidth 96 | + legendSampleWidth + textPad + w) + 5*textPad 97 | let x = x'- w' 98 | y = y'- h' - t 99 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h') 100 | renderLegendEntries (x+3*textPad) (y+textPad) 101 | (textPad + legendSampleWidth + legendSampleWidth + textPad 102 | + w + textPad) 0 0 h to ls 103 | return () 104 | | l == East = do 105 | let w' = textPad + legendSampleWidth + legendSampleWidth 106 | + textPad + w + textPad 107 | bbShiftRight $ w' + 4*textPad 108 | return $ \(Padding _ r _ _) -> do 109 | x' <- bbRightWidth 110 | y' <- bbCentreHeight 111 | let h' = (fromIntegral ln)*(h+textPad) + 5*textPad 112 | let x = x' + 4*textPad + r 113 | y = y'-(h'/2) 114 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h') 115 | renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad) 116 | 0 h to ls 117 | return () 118 | | l == SouthEast = do 119 | let h' = textPad + h + textPad 120 | bbRaiseBottom $ h' + 4*textPad 121 | return $ \(Padding _ _ b' _) -> do 122 | x' <- bbRightWidth 123 | y' <- bbBottomHeight 124 | let w' = (fromIntegral ln)*(textPad + legendSampleWidth 125 | + legendSampleWidth + textPad + w) + 5*textPad 126 | let x = x'- w' 127 | y = y' + b' +textPad 128 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h') 129 | renderLegendEntries (x+3*textPad) (y+textPad) 130 | (textPad + legendSampleWidth + legendSampleWidth + textPad 131 | + w + textPad) 0 0 h to ls 132 | return () 133 | | l == South = do 134 | let h' = textPad + h + textPad 135 | bbRaiseBottom $ h' + 4*textPad 136 | return $ \(Padding _ _ b' _) -> do 137 | x' <- bbCentreWidth 138 | y' <- bbBottomHeight 139 | let w' = (fromIntegral ln)*(textPad + legendSampleWidth 140 | + legendSampleWidth + textPad + w) + 5*textPad 141 | let x = x' - (w'/2) 142 | y = y' + b' +textPad 143 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h') 144 | renderLegendEntries (x+3*textPad) (y+textPad) 145 | (textPad + legendSampleWidth + legendSampleWidth + textPad 146 | + w + textPad) 0 0 h to ls 147 | return () 148 | | l == SouthWest = do 149 | let h' = textPad + h + textPad 150 | bbRaiseBottom $ h' + 4*textPad 151 | return $ \(Padding _ _ b' _) -> do 152 | x' <- bbLeftWidth 153 | y' <- bbBottomHeight 154 | let w' = (fromIntegral ln)*(textPad + legendSampleWidth 155 | + legendSampleWidth + textPad + w) + 5*textPad 156 | let x = x' 157 | y = y' + b' +textPad 158 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h') 159 | renderLegendEntries (x+3*textPad) (y+textPad) 160 | (textPad + legendSampleWidth + legendSampleWidth + textPad 161 | + w + textPad) 0 0 h to ls 162 | return () 163 | | l == West = do 164 | let w' = textPad + legendSampleWidth + legendSampleWidth + textPad 165 | + w + textPad 166 | bbShiftLeft $ w' + 4*textPad 167 | return $ \(Padding l' _ _ _) -> do 168 | x' <- bbLeftWidth 169 | y' <- bbCentreHeight 170 | let h' = (fromIntegral ln)*(h+textPad) + 5*textPad 171 | let x = x' - w' - 4*textPad - l' 172 | y = y'-(h'/2) 173 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h') 174 | renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad) 175 | 0 h to ls 176 | return () 177 | | l == NorthWest = do 178 | let h' = textPad + h + textPad 179 | bbLowerTop $ h' + 4*textPad 180 | return $ \(Padding _ _ _ t) -> do 181 | x' <- bbLeftWidth 182 | y' <- bbTopHeight 183 | let w' = (fromIntegral ln)*(textPad + legendSampleWidth 184 | + legendSampleWidth + textPad + w) + 5*textPad 185 | let x = x' 186 | y = y'- h' - t 187 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h') 188 | renderLegendEntries (x+3*textPad) (y+textPad) 189 | (textPad + legendSampleWidth + legendSampleWidth + textPad 190 | + w + textPad) 0 0 h to ls 191 | return () 192 | renderLegendOutside _ _ _ _ _ _ _ = return (\_ -> return ()) 193 | 194 | renderBorder :: Double -> Color -> Double -> Double -> Double -> Double -> C.Render () 195 | renderBorder lw c x y w h = do 196 | C.setLineWidth lw 197 | setColour c 198 | C.rectangle x y w h 199 | C.stroke 200 | 201 | renderLegendInside :: Bool -> LegendLocation -> Double -> Double -> TextOptions -> Int -> [(SeriesLabel,Decoration)] -> Render () 202 | renderLegendInside b l w h to ln ls = do 203 | let w' = (textPad + legendSampleWidth + legendSampleWidth + textPad 204 | + w + textPad) 205 | h' = h+textPad 206 | h'' = (fromIntegral ln)*h'+textPad 207 | (x,y) <- case l of 208 | North -> do 209 | x' <- bbCentreWidth 210 | y' <- bbTopHeight 211 | return (x'-w'/2-textPad,y'+textPad) 212 | NorthEast -> do 213 | x' <- bbRightWidth 214 | y' <- bbTopHeight 215 | return (x'-w'-3*textPad,y'+textPad) 216 | East -> do 217 | x' <- bbRightWidth 218 | y' <- bbCentreHeight 219 | let y'' = y' - h''/2 220 | return (x'-w'-3*textPad,y''-textPad) 221 | SouthEast -> do 222 | x' <- bbRightWidth 223 | y' <- bbBottomHeight 224 | let y'' = y' - h'' 225 | return (x'-w'-3*textPad,y''-3*textPad) 226 | South -> do 227 | x' <- bbCentreWidth 228 | y' <- bbBottomHeight 229 | let y'' = y' - h'' 230 | return (x'-w'/2-textPad,y''-3*textPad) 231 | SouthWest -> do 232 | x' <- bbLeftWidth 233 | y' <- bbBottomHeight 234 | let y'' = y' - h'' 235 | return (x'+textPad,y''-3*textPad) 236 | West -> do 237 | x' <- bbLeftWidth 238 | y' <- bbCentreHeight 239 | let y'' = y' - h''/2 240 | return (x'+textPad,y''-textPad) 241 | NorthWest -> do 242 | x' <- bbLeftWidth 243 | y' <- bbTopHeight 244 | return (x'+textPad,y'+textPad) 245 | when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h'') 246 | cairo $ do 247 | --C.setSourceRGBA 1 0 0 0 248 | setColour white 249 | C.rectangle (x+0.5) (y+0.5) w' h'' 250 | C.fill 251 | C.stroke 252 | renderLegendEntries (x+3*textPad) (y+textPad) 0 h' w' 253 | (h'-textPad) to ls 254 | 255 | renderLegendEntries :: Double -> Double -> Double -> Double -> Double -> Double 256 | -> TextOptions 257 | -> [(SeriesLabel,Decoration)] -> Render () 258 | renderLegendEntries x y wa ha w h to ls = do 259 | _ <- foldM (renderLegendEntry wa ha w h to) (x,y) ls 260 | return () 261 | 262 | renderLegendEntry :: Double -> Double -> Double -> Double -> TextOptions -> (Double,Double) -> (SeriesLabel,Decoration) -> Render (Double,Double) 263 | renderLegendEntry wa ha _w h to (x,y) (l,d) = do 264 | renderLegendSample x y legendSampleWidth h d 265 | pc <- asks _pangocontext 266 | cairo $ do 267 | lo <- pango $ P.layoutText pc l 268 | setTextOptions to lo 269 | showText lo (x+legendSampleWidth + 2*textPad) y 270 | return (x+wa,y+ha) 271 | 272 | renderLegendSample :: Double -> Double -> Double -> Double -> Decoration -> Render () 273 | renderLegendSample x y w h d = do 274 | let l = decorationGetLineType d 275 | let p = decorationGetPointType d 276 | case l of 277 | Nothing -> return () 278 | Just l' -> do 279 | cairo $ do 280 | setLineStyle l' 281 | C.moveTo x (y+h/2+0.5) 282 | C.lineTo (x+w) (y+h/2+0.5) 283 | C.stroke 284 | case p of 285 | Nothing -> return () 286 | Just p' -> do 287 | cairo $ do 288 | C.save 289 | C.moveTo (x+w/2) (y+h/2) 290 | g <- setPointStyle p' 291 | renderGlyph 1 g 292 | C.restore 293 | 294 | ----------------------------------------------------------------------------- 295 | 296 | getLabels :: DataSeries -> (Int,[(SeriesLabel,Decoration)]) 297 | getLabels (DS_Y d) = let mls = map (\(DecSeries o d') -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d 298 | ln = length mls 299 | in (ln,mls) 300 | getLabels (DS_1toN _ d) = let mls = map (\(DecSeries o d') -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d 301 | ln = length mls 302 | in (ln,mls) 303 | getLabels (DS_1to1 d) = let mls = map (\(_,(DecSeries o d')) -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d 304 | ln = length mls 305 | in (ln,mls) 306 | getLabels (DS_Surf _) = (0,[]) 307 | 308 | ----------------------------------------------------------------------------- 309 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE UndecidableInstances #-} 4 | ----------------------------------------------------------------------------- 5 | -- | 6 | -- Module : Graphics.Rendering.Plot.Figure 7 | -- Copyright : (c) A. V. H. McPhail 2010 8 | -- License : BSD3 9 | -- 10 | -- Maintainer : haskell.vivian.mcphail gmail com 11 | -- Stability : provisional 12 | -- Portability : portable 13 | -- 14 | -- Creation and manipulation of 'Figure's 15 | -- 16 | -- The same problem of leaked instances as at occurs here. 17 | -- 18 | -- 19 | -- /with/, /set/, /clear/, /new/, and /add/ are the operations that can 20 | -- be performed on various elements of a figure. 21 | -- 22 | -- /glib/\//data-accessor/ abstractions (verbs/modifiers) are planned for future implementations 23 | 24 | ----------------------------------------------------------------------------- 25 | 26 | module Graphics.Rendering.Plot.Figure ( 27 | module Data.Colour.Names 28 | -- * Top level operation 29 | , Figure(), FigureState() 30 | -- * Default options 31 | , withTextDefaults 32 | , withLineDefaults 33 | , withPointDefaults 34 | , withBarDefaults 35 | -- * Figures 36 | , newFigure 37 | -- ** Formatting 38 | , setBackgroundColour 39 | , setFigurePadding 40 | , withTitle 41 | , withSubTitle 42 | , setPlots 43 | , withPlot, withPlots 44 | -- * Sub-plots 45 | , Plot() 46 | -- ** Colour 47 | , setPlotBackgroundColour 48 | -- ** Plot elements 49 | , Border 50 | , setBorder 51 | , setPlotPadding 52 | , withHeading 53 | -- ** Series data 54 | , Function(), VectorFunction(), Series(), MinMaxSeries(), ErrorSeries() 55 | , Surface() 56 | , SeriesLabel() 57 | , Abscissa(), Ordinate(), Dataset() 58 | , FormattedSeries(), SeriesType(..) 59 | , line, point, linepoint 60 | , impulse, step 61 | , area 62 | , bar 63 | , hist 64 | , candle, whisker 65 | , setDataset 66 | -- * Annotations 67 | , Location, Head, Fill 68 | , Annote() 69 | , arrow 70 | , oval 71 | , rect 72 | , glyph 73 | , text 74 | , cairo 75 | , withAnnotations 76 | -- ** Plot type 77 | , setSeriesType 78 | , setAllSeriesTypes 79 | -- ** Formatting 80 | , PlotFormats() 81 | , withSeriesFormat 82 | , withAllSeriesFormats 83 | -- * Range 84 | , Scale(..) 85 | , setRange 86 | , setRangeFromData 87 | -- * Axes 88 | , Axis 89 | , AxisType(..),AxisSide(..),AxisPosn(..) 90 | , clearAxes 91 | , clearAxis 92 | , addAxis 93 | , withAxis 94 | -- * BarSetting 95 | , BarSetting(..) 96 | , barSetting 97 | -- * Data Sampling 98 | , SampleData 99 | , sampleData 100 | -- * Legend 101 | , Legend 102 | , LegendBorder 103 | , LegendLocation(..), LegendOrientation(..) 104 | , clearLegend 105 | , setLegend 106 | , withLegendFormat 107 | -- ** Formatting 108 | , Tick(..), TickValues(..), GridLines 109 | , TickFormat(..) 110 | , setTicks 111 | , setGridlines 112 | , setTickLabelFormat 113 | , setTickLabels 114 | , withTickLabelsFormat 115 | , withAxisLabel 116 | , withAxisLine 117 | , withGridLine 118 | -- * Lines 119 | , Line(), LineFormat() 120 | , DashStyle,Dash(..),LineWidth 121 | , clearLineFormat 122 | , setDashStyle 123 | , setLineWidth 124 | , setLineColour 125 | -- * Points 126 | , Point(), PointFormat() 127 | , Glyph(..) 128 | , PointSize 129 | , setGlyph 130 | , setPointSize 131 | , setPointColour 132 | -- * Bars 133 | , Bar(), BarFormat() 134 | , clearBarFormat 135 | , setBarWidth 136 | , setBarColour 137 | , setBarBorderWidth 138 | , setBarBorderColour 139 | -- * Text labels 140 | , Text() 141 | , FontFamily,FontSize,Color 142 | -- | A text element must exist for formatting to work 143 | , clearText 144 | , clearTextFormat 145 | , setText 146 | , setFontFamily 147 | , setFontStyle 148 | , setFontVariant 149 | , setFontWeight 150 | , setFontStretch 151 | , setFontSize 152 | , setFontColour 153 | ) where 154 | 155 | ----------------------------------------------------------------------------- 156 | 157 | --import Data.Packed.Vector 158 | --import Numeric.LinearAlgebra.Linear 159 | 160 | --import Data.Word 161 | --import Data.Colour.SRGB 162 | import Data.Colour.Names 163 | 164 | import qualified Data.Array.IArray as A 165 | 166 | --import qualified Graphics.Rendering.Cairo as C 167 | --import qualified Graphics.Rendering.Pango as P 168 | 169 | --import Control.Monad.State 170 | --import Control.Monad.Reader 171 | 172 | import Prelude hiding(min,max) 173 | 174 | import Graphics.Rendering.Plot.Figure.Text 175 | import Graphics.Rendering.Plot.Figure.Line 176 | import Graphics.Rendering.Plot.Figure.Point 177 | import Graphics.Rendering.Plot.Figure.Bar 178 | import Graphics.Rendering.Plot.Figure.Plot 179 | 180 | import Graphics.Rendering.Plot.Types 181 | import Graphics.Rendering.Plot.Defaults 182 | 183 | ----------------------------------------------------------------------------- 184 | 185 | -- | perform some actions on the text defaults, must be run before other text element modifications 186 | withTextDefaults :: Text () -> Figure () 187 | withTextDefaults m = do 188 | o <- getDefaults 189 | let to' = _textoptions o 190 | let (FontText to _) = execText m to' (FontText to' "") 191 | modifyDefaults $ \s -> s { _textoptions = to } 192 | 193 | -- | perform some actions on the line defaults, must be run before other line element modifications 194 | withLineDefaults :: Line () -> Figure () 195 | withLineDefaults m = do 196 | o <- getDefaults 197 | let lo' = _lineoptions o 198 | let (TypeLine lo _) = execLine m lo' (TypeLine lo' black) 199 | modifyDefaults $ \s -> s { _lineoptions = lo } 200 | 201 | -- | perform some actions on the point defaults, must be run before other point modifications 202 | withPointDefaults :: Point () -> Figure () 203 | withPointDefaults m = do 204 | o <- getDefaults 205 | let po' = _pointoptions o 206 | let (FullPoint po _) = execPoint m po' (FullPoint po' defaultGlyph) 207 | modifyDefaults $ \s -> s { _pointoptions = po } 208 | 209 | -- | perform some actions on the bar defaults, must be run before other point modifications 210 | withBarDefaults :: Bar () -> Figure () 211 | withBarDefaults m = do 212 | o <- getDefaults 213 | let bo' = _baroptions o 214 | let (TypeBar bo _) = execBar m bo' (TypeBar bo' black) 215 | modifyDefaults $ \s -> s { _baroptions = bo } 216 | 217 | ----------------------------------------------------------------------------- 218 | 219 | -- | create a new blank 'Figure' 220 | newFigure :: Figure () 221 | newFigure = putFigure $ Figure defaultFigureBackgroundColour 222 | defaultFigurePadding NoText NoText 223 | (A.listArray ((1,1),(1,1)) [Nothing]) 224 | {- 225 | newLineFigure :: DataSeries -- ^ the y series 226 | -> FigureData 227 | newLineFigure d@(DS_1toN _ _) = let ((xmin,xmax),(ymin,ymax)) = calculateRanges d 228 | plot = Plot False defaultPlotPadding NoText 229 | (defaultRanges xmin xmax ymin ymax) 230 | [defaultXAxis,defaultYAxis] 231 | Nothing Line d [] 232 | in Figure defaultFigurePadding NoText NoText 233 | (A.listArray ((1,1),(1,1)) [Just plot]) 234 | -} 235 | {- 236 | -- | create a new 'Figure' 237 | newFigure :: PlotType -> DataSeries -> Figure () 238 | newFigure Line d@(DS_1toN _ _) = putFigure $ newLineFigure d 239 | --newFigure _ _ = error "Figure type not implemented" 240 | -} 241 | 242 | 243 | ----------------------------------------------------------------------------- 244 | 245 | -- | set the background colour of the figure 246 | setBackgroundColour :: Color -> Figure () 247 | setBackgroundColour c = modifyFigure $ \s -> s { _back_clr = c } 248 | 249 | -- | set the padding of the figure 250 | setFigurePadding :: Double -> Double -> Double -> Double -> Figure () 251 | setFigurePadding l r b t = modifyFigure $ \s -> 252 | s { _fig_pads = Padding l r b t } 253 | 254 | -- | operate on the title 255 | withTitle :: Text () -> Figure () 256 | withTitle m = do 257 | o <- getDefaults 258 | modifyFigure $ \s -> 259 | s { _title = execText m (_textoptions o) (_title s) } 260 | 261 | -- | operate on the sub-title 262 | withSubTitle :: Text () -> Figure () 263 | withSubTitle m = do 264 | o <- getDefaults 265 | modifyFigure $ \s -> 266 | s { _subtitle = execText m (_textoptions o) (_title s) } 267 | 268 | -- | set the shape of the plots, losing all current plots 269 | setPlots :: Int -- ^ rows 270 | -> Int -- ^ columns 271 | -> Figure () 272 | setPlots r c = modifyFigure $ \s -> 273 | s { _plots = A.listArray ((1,1),(r,c)) 274 | (replicate (r*c) Nothing) } 275 | 276 | -- | perform some actions on the specified subplot 277 | withPlot :: (Int,Int) -> Plot () -> Figure () 278 | withPlot i m = do 279 | o <- getDefaults 280 | s <- getSupplies 281 | modifyFigure $ \p -> 282 | p { _plots = let plots = _plots p 283 | plot' = plots A.! i 284 | plot = case plot' of 285 | Nothing -> emptyPlot 286 | Just p' -> p' 287 | -- we revert supplies to the original here 288 | -- since we might want the same colour 289 | -- order for all plots 290 | -- HOWEVER: need a better execPlot group 291 | in plots A.// [(i,Just $ execPlot m s o plot)] } 292 | 293 | -- | perform some actions all subplots 294 | withPlots :: Plot () -> Figure () 295 | withPlots m = do 296 | o <- getDefaults 297 | s <- getSupplies 298 | modifyFigure $ \p -> 299 | p { _plots = let plots = _plots p 300 | plot p' = case p' of 301 | Nothing -> emptyPlot 302 | Just p'' -> p'' 303 | in plots A.// map (\(i,e) -> 304 | (i,Just $ execPlot m s o (plot e))) (A.assocs plots) } 305 | 306 | ----------------------------------------------------------------------------- 307 | 308 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Figure/Plot.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Graphics.Rendering.Plot.Figure.Plot 4 | -- Copyright : (c) A. V. H. McPhail 2010 5 | -- License : BSD3 6 | -- 7 | -- Maintainer : haskell.vivian.mcphail gmail com 8 | -- Stability : provisional 9 | -- Portability : portable 10 | -- 11 | -- Creation and manipulation of 'Plot's 12 | -- 13 | ----------------------------------------------------------------------------- 14 | 15 | module Graphics.Rendering.Plot.Figure.Plot ( 16 | Plot 17 | -- * Plot elements 18 | , Border 19 | , setBorder 20 | , setPlotBackgroundColour 21 | , setPlotPadding 22 | , withHeading 23 | -- * Series data 24 | , D.Abscissa(), D.Ordinate(), D.Dataset() 25 | , SeriesLabel 26 | , D.FormattedSeries() 27 | , D.line, D.point, D.linepoint 28 | , D.impulse, D.step 29 | , D.area 30 | , D.bar 31 | , D.hist 32 | , D.candle, D.whisker 33 | , setDataset 34 | -- * Annotations 35 | , Location, Head, Fill 36 | , AN.arrow 37 | , AN.oval 38 | , AN.rect 39 | , AN.glyph 40 | , AN.text 41 | , AN.cairo 42 | , withAnnotations 43 | -- ** Plot type 44 | , setSeriesType 45 | , setAllSeriesTypes 46 | -- ** Formatting 47 | , D.PlotFormats(..) 48 | , withSeriesFormat 49 | , withAllSeriesFormats 50 | -- * Range 51 | , Scale(..) 52 | , setRange 53 | , setRangeFromData 54 | -- * Axes 55 | , AX.Axis 56 | , AxisType(..),AxisSide(..),AxisPosn(..) 57 | , clearAxes 58 | , clearAxis 59 | , addAxis 60 | , withAxis 61 | -- * BarSetting 62 | , barSetting 63 | -- * SampleData 64 | , sampleData 65 | -- * Legend 66 | , L.Legend 67 | , LegendBorder 68 | , L.LegendLocation(..), L.LegendOrientation(..) 69 | , clearLegend 70 | , setLegend 71 | , withLegendFormat 72 | -- ** Formatting 73 | , Tick(..), TickValues(..), GridLines 74 | , TickFormat(..) 75 | , AX.setTicks 76 | , AX.setGridlines 77 | , AX.setTickLabelFormat 78 | , AX.setTickLabels 79 | , AX.withTickLabelsFormat 80 | , AX.withAxisLabel 81 | , AX.withAxisLine 82 | , AX.withGridLine 83 | ) where 84 | 85 | ----------------------------------------------------------------------------- 86 | 87 | --import Data.Eq.Unicode 88 | --import Data.Bool.Unicode 89 | --import Data.Ord.Unicode 90 | 91 | import Numeric.LinearAlgebra.Data hiding(Range) 92 | 93 | import qualified Data.Array.IArray as A 94 | 95 | import Control.Monad.State 96 | import Control.Monad.Reader 97 | --import Control.Monad.Supply 98 | 99 | import Prelude hiding(min,max) 100 | import qualified Prelude as Prelude 101 | 102 | import Graphics.Rendering.Plot.Types 103 | import Graphics.Rendering.Plot.Defaults 104 | import qualified Graphics.Rendering.Plot.Figure.Text as T 105 | import qualified Graphics.Rendering.Plot.Figure.Plot.Data as D 106 | import qualified Graphics.Rendering.Plot.Figure.Plot.Axis as AX 107 | import qualified Graphics.Rendering.Plot.Figure.Plot.Legend as L 108 | import qualified Graphics.Rendering.Plot.Figure.Plot.Annotation as AN 109 | 110 | ----------------------------------------------------------------------------- 111 | 112 | -- | whether to draw a boundary around the plot area 113 | setBorder :: Border -> Plot () 114 | setBorder b = modify $ \s -> s { _border = b } 115 | 116 | -- | set the plot background colour 117 | setPlotBackgroundColour :: Color -> Plot () 118 | setPlotBackgroundColour c = modify $ \s -> s { _back_colr = c } 119 | 120 | -- | set the padding of the subplot 121 | setPlotPadding :: Double -> Double -> Double -> Double -> Plot () 122 | setPlotPadding l r b t = modify $ \s -> s { _plot_pads = Padding l r b t } 123 | 124 | -- | set the heading of the subplot 125 | withHeading :: Text () -> Plot () 126 | withHeading m = do 127 | o <- asks _textoptions 128 | modify $ \s -> s { _heading = execText m o (_heading s) } 129 | 130 | ----------------------------------------------------------------------------- 131 | 132 | -- | set the axis range 133 | setRange :: AxisType -> AxisSide -> Scale -> Double -> Double -> Plot () 134 | setRange XAxis sd sc min max = modify $ \s -> s { _ranges = setXRanges' (_ranges s) } 135 | where setXRanges' r 136 | | sc == Log && min <= 0 = error "non-positive logarithmic range" 137 | | otherwise = setXRanges sd r 138 | setXRanges Lower (Ranges (Left _) yr) = Ranges (Left (Range sc min max)) yr 139 | setXRanges Lower (Ranges (Right (_,xr)) yr) = Ranges (Right ((Range sc min max,xr))) yr 140 | setXRanges Upper (Ranges (Left xr) yr) = Ranges (Right (xr,Range sc min max)) yr 141 | setXRanges Upper (Ranges (Right (_,xr)) yr) = Ranges (Right (Range sc min max,xr)) yr 142 | setRange YAxis sd sc min max = modify $ \s -> s { _ranges = setYRanges' (_ranges s) } 143 | where setYRanges' r 144 | | sc == Log && min <= 0 = error "non-positive logarithmic range" 145 | | otherwise = setYRanges sd r 146 | setYRanges Lower (Ranges xr (Left _)) = Ranges xr (Left (Range sc min max)) 147 | setYRanges Lower (Ranges xr (Right (_,yr))) = Ranges xr (Right ((Range sc min max,yr))) 148 | setYRanges Upper (Ranges xr (Left yr)) = Ranges xr (Right (yr,Range sc min max)) 149 | setYRanges Upper (Ranges xr (Right (_,yr))) = Ranges xr (Right ((Range sc min max,yr))) 150 | 151 | -- | set the axis ranges to values based on dataset 152 | setRangeFromData :: AxisType -> AxisSide -> Scale -> Plot () 153 | setRangeFromData ax sd sc = do 154 | ds <- gets _data 155 | let ((xmin,xmax),(ymin,ymax)) = calculateRanges ds 156 | case ax of 157 | XAxis -> setRange ax sd sc (if sc == Log then if xmin == 0 then 1 else xmin else xmin) xmax 158 | YAxis -> setRange ax sd sc (if sc == Log then if ymin == 0 then 1 else ymin else ymin) ymax 159 | 160 | ----------------------------------------------------------------------------- 161 | 162 | withAnnotations :: Annote () -> Plot () 163 | withAnnotations = annoteInPlot 164 | 165 | ----------------------------------------------------------------------------- 166 | 167 | -- | clear the axes of a subplot 168 | clearAxes :: Plot () 169 | clearAxes = modify $ \s -> s { _axes = [] } 170 | 171 | -- | clear an axis of a subplot 172 | clearAxis :: AxisType -> AxisPosn -> Plot () 173 | clearAxis at axp = do 174 | ax <- gets _axes 175 | modify $ \s -> s { _axes = 176 | filter (\(Axis at' axp' _ _ _ _ _ _) -> not (at == at' && axp == axp')) ax } 177 | 178 | -- | add an axis to the subplot 179 | addAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot () 180 | addAxis at axp m = do 181 | ax' <- gets _axes 182 | o <- ask 183 | let ax = execAxis m o (defaultAxis at axp) 184 | modify $ \s -> s { _axes = ax : ax' } 185 | 186 | -- | operate on the given axis 187 | withAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot () 188 | withAxis at axp m = do 189 | axes' <- gets _axes 190 | o <- ask 191 | modify $ \s -> s { _axes = 192 | map (\a@(Axis at' ap' _ _ _ _ _ _) -> if at == at' && axp == ap' 193 | then execAxis m o a 194 | else a) axes' } 195 | 196 | ----------------------------------------------------------------------------- 197 | 198 | barSetting :: BarSetting -> Plot () 199 | barSetting bc = modify $ \s -> s { _barconfig = bc } 200 | 201 | ----------------------------------------------------------------------------- 202 | 203 | sampleData :: SampleData -> Plot () 204 | sampleData sd = modify $ \s -> s { _sampledata = sd } 205 | 206 | ----------------------------------------------------------------------------- 207 | 208 | -- | clear the legend 209 | clearLegend :: Plot () 210 | clearLegend = withLegend $ L.clearLegend 211 | 212 | -- | set the legend location and orientation 213 | setLegend :: L.LegendBorder -> L.LegendLocation -> L.LegendOrientation -> Plot () 214 | setLegend b l o = withLegend $ L.setLegend b l o 215 | 216 | -- | format the legend text 217 | withLegendFormat :: T.Text () -> Plot () 218 | withLegendFormat f = withLegend $ L.withLegendFormat f 219 | 220 | -- | operate on the legend 221 | withLegend :: L.Legend () -> Plot () 222 | withLegend = legendInPlot 223 | 224 | ----------------------------------------------------------------------------- 225 | 226 | -- | operate on the data 227 | withData :: D.Data () -> Plot () 228 | withData = dataInPlot 229 | 230 | {- | set the data series of the subplot 231 | 232 | The data series are either 'FormattedSeries' or plain data series. 233 | A plain data series must carry a 'SeriesType'. 234 | 235 | A dataset may or may not have an abscissa series, and if so, it is paired 236 | with either a list of ordinate series or a single ordinate series. 237 | 238 | The abscissa series (if present) is of type 'Vector Double'. 239 | 240 | An ordinate series be a function (@Double -> Double@) or a series of points, 241 | a 'Vector Double' with optional error series, y axis preference, and labels. 242 | 243 | To specify decoration options for an ordinate series, use the appropriate function, such 244 | as 'linespoints', with the ordinate series and decoration formatting ('LineFormat', 245 | 'PointFormat', and 'BarFormat') as arguments. 246 | 247 | > setDataset (ts,[linespoints (xs,(le,ue),Upper,"data") (([Dash,Dash],3,blue),(Diamond,green))]) 248 | 249 | has abscissa @ts@ paired with a list of ordinate series, the single element of which is a 250 | 'FormattedSeries', @linespoints@ where the ordinate is @xs@ with error series @le@ and @ue@, 251 | to be graphed against the upper y-range with label \"data\". The line element is formatted 252 | to be dashed, of width 3, and blue and the point element is to be a green diamond. 253 | -} 254 | setDataset :: D.Dataset a => a -> Plot () 255 | setDataset d = withData $ D.setDataSeries d 256 | 257 | -- | set the plot type of a given data series 258 | setSeriesType :: Int -> SeriesType -> Plot () 259 | setSeriesType i t = withData $ D.setSeriesType t i 260 | 261 | -- | change the plot type of all data series 262 | setAllSeriesTypes :: SeriesType -> Plot () 263 | setAllSeriesTypes t = withData $ D.setAllSeriesTypes t 264 | 265 | -- | format the plot elements of a given series 266 | withSeriesFormat :: D.PlotFormats m => Int -> m () -> Plot () 267 | withSeriesFormat i f = withData $ D.withSeriesFormat i f 268 | 269 | {- | 270 | format the plot elements of all series 271 | 272 | the operation to modify the formats is passed the series index. 273 | This allows, for example, colours to be selected from a list 274 | that gets indexed by the argument 275 | 276 | > setColour = withAllSeriesFormats (\i -> do 277 | > setLineColour $ [black,blue,red,green,yellow] !! i 278 | > setLineWidth 1.0) 279 | -} 280 | withAllSeriesFormats :: D.PlotFormats m => (Int -> m ()) -> Plot () 281 | withAllSeriesFormats f = withData $ D.withAllSeriesFormats f 282 | 283 | ----------------------------------------------------------------------------- 284 | 285 | findMinMax :: Abscissae -> Ordinates -> (Double,Double) 286 | findMinMax (AbsFunction _) (OrdFunction _ f _) = 287 | let v = f (linspace 100 (-1,1)) 288 | in (minElement v,maxElement v) 289 | findMinMax (AbsPoints _ x) (OrdFunction _ f _) = 290 | let v = f x 291 | in (minElement v,maxElement v) 292 | -- what if errors go beyond plot? 293 | findMinMax _ (OrdPoints _ (Plain o) _) = (minElement o,maxElement o) 294 | findMinMax _ (OrdPoints _ (Error o _) _) = (minElement o,maxElement o) 295 | findMinMax _ (OrdPoints _ (MinMax (o,p) _) _) = 296 | (Prelude.min (minElement o) (minElement p) 297 | ,Prelude.max (maxElement o) (maxElement p)) 298 | 299 | abscMinMax :: Abscissae -> (Double,Double) 300 | abscMinMax (AbsFunction _) = defaultXAxisSideLowerRange 301 | abscMinMax (AbsPoints _ x) = (minElement x,maxElement x) 302 | 303 | 304 | ordDim :: Ordinates -> Int 305 | ordDim (OrdFunction _ _ _) = 1 306 | ordDim (OrdPoints _ o _) = size $ getOrdData o 307 | 308 | 309 | calculateRanges :: DataSeries -> ((Double,Double),(Double,Double)) 310 | calculateRanges (DS_Y ys) = 311 | let xmax = maximum $ map (\(DecSeries o _) -> 312 | fromIntegral $ ordDim o) $ A.elems ys 313 | ym = unzip $ map (\(DecSeries o _) -> 314 | findMinMax (AbsFunction id) o) $ A.elems ys 315 | ymm = (minimum $ fst ym,maximum $ snd ym) 316 | in ((0,xmax),ymm) 317 | calculateRanges (DS_1toN x ys) = 318 | let ym = unzip $ map (\(DecSeries o _) -> findMinMax x o) $ A.elems ys 319 | ymm = (minimum $ fst ym,maximum $ snd ym) 320 | xmm = abscMinMax x 321 | in (xmm,ymm) 322 | calculateRanges (DS_1to1 ys) = 323 | let (xm',ym') = unzip $ A.elems ys 324 | ym = unzip $ map (\(x,(DecSeries o _)) -> findMinMax x o) (zip xm' ym') 325 | ymm = (minimum $ fst ym,maximum $ snd ym) 326 | xm = unzip $ map abscMinMax xm' 327 | xmm = (minimum $ fst xm,maximum $ snd xm) 328 | in (xmm,ymm) 329 | calculateRanges (DS_Surf m) = 330 | ((0,fromIntegral $ cols m),(fromIntegral $ rows m,0)) 331 | 332 | ----------------------------------------------------------------------------- 333 | 334 | -------------------------------------------------------------------------------- /lib/Graphics/Rendering/Plot/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiParamTypeClasses #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE TypeSynonymInstances #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE FlexibleContexts #-} 6 | {-# LANGUAGE CPP #-} 7 | ----------------------------------------------------------------------------- 8 | -- | 9 | -- Module : Graphics.Rendering.Plot.Types 10 | -- Copyright : (c) A. V. H. McPhail 2010, 2015 11 | -- License : BSD3 12 | -- 13 | -- Maintainer : haskell.vivian.mcphail gmail com 14 | -- Stability : provisional 15 | -- Portability : portable 16 | -- 17 | -- Types 18 | -- 19 | ----------------------------------------------------------------------------- 20 | 21 | module Graphics.Rendering.Plot.Types where 22 | 23 | ----------------------------------------------------------------------------- 24 | 25 | import Numeric.LinearAlgebra.Data hiding(Range) 26 | 27 | import Data.Colour.SRGB 28 | import Data.Colour() 29 | 30 | import qualified Data.Array.IArray as A 31 | 32 | import qualified Graphics.Rendering.Cairo as C 33 | import qualified Graphics.Rendering.Pango as P 34 | 35 | #if !(MIN_VERSION_base(4,8,0)) 36 | import Control.Applicative 37 | #endif 38 | import Control.Monad.State 39 | import Control.Monad.Reader 40 | 41 | import Control.Monad.Supply 42 | 43 | ----------------------------------------------------------------------------- 44 | ----------------------------------------------------------------------------- 45 | ----------------------------------------------------------------------------- 46 | 47 | type Color = Colour Double 48 | 49 | ----------------------------------------------------------------------------- 50 | 51 | -- x,y,w,h 52 | data BoundingBox = BoundingBox { _bbX :: Double, _bbY :: Double 53 | , _bbW :: Double, _bbH :: Double } 54 | 55 | ----------------------------------------------------------------------------- 56 | 57 | type FontFamily = String 58 | type FontSize = Double 59 | data FontOptions = FontOptions FontFamily P.FontStyle P.Variant P.Weight P.Stretch 60 | data TextOptions = TextOptions FontOptions FontSize Color 61 | data TextEntry = NoText 62 | | BareText String 63 | | SizeText FontSize Color String 64 | | FontText TextOptions String 65 | 66 | ----------------------------------------------------------------------------- 67 | 68 | newtype Text a = FT { runText :: ReaderT TextOptions (State TextEntry) a} 69 | deriving(Monad, Functor, Applicative, MonadReader TextOptions, MonadState TextEntry) 70 | 71 | execText :: Text a -> TextOptions -> TextEntry -> TextEntry 72 | execText m r = execState (runReaderT (runText m) r) 73 | 74 | ----------------------------------------------------------------------------- 75 | 76 | type Solid = Bool 77 | 78 | type PointSize = Double 79 | data Glyph = Box | Cross | Diamond | Asterisk | Triangle | Circle | Bullet | Top | Bot 80 | --data GlyphType = Glyph Glyph Solid 81 | data PointOptions = PointOptions PointSize Color 82 | data PointType = FullPoint PointOptions Glyph 83 | 84 | ----------------------------------------------------------------------------- 85 | 86 | newtype Point a = FG { runPoint :: ReaderT PointOptions (State PointType) a} 87 | deriving(Monad, Functor, Applicative, MonadReader PointOptions, MonadState PointType) 88 | 89 | execPoint :: Point a -> PointOptions -> PointType -> PointType 90 | execPoint m r = execState (runReaderT (runPoint m) r) 91 | 92 | ----------------------------------------------------------------------------- 93 | 94 | data Dash = Dot | Dash deriving(Eq) 95 | type DashStyle = [Dash] 96 | type LineWidth = Double 97 | -- not using line join 98 | -- not using line cap 99 | -- do we want arrows? 100 | data LineOptions = LineOptions DashStyle LineWidth 101 | deriving(Eq) 102 | 103 | data LineType = NoLine 104 | | ColourLine Color 105 | | TypeLine LineOptions Color 106 | deriving(Eq) 107 | 108 | ----------------------------------------------------------------------------- 109 | 110 | newtype Line a = FL { runLine :: ReaderT LineOptions (State LineType) a} 111 | deriving(Monad, Functor, Applicative, MonadReader LineOptions, MonadState LineType) 112 | 113 | execLine :: Line a -> LineOptions -> LineType -> LineType 114 | execLine m r = execState (runReaderT (runLine m) r) 115 | 116 | ----------------------------------------------------------------------------- 117 | 118 | type Width = Double 119 | data BarOptions = BarOptions Width LineWidth Color 120 | 121 | data BarType = ColourBar Color 122 | | TypeBar BarOptions Color 123 | 124 | ----------------------------------------------------------------------------- 125 | 126 | newtype Bar a = FB { runBar :: ReaderT BarOptions (State BarType) a} 127 | deriving(Monad, Functor, Applicative, MonadReader BarOptions, MonadState BarType) 128 | 129 | execBar :: Bar a -> BarOptions -> BarType -> BarType 130 | execBar m r = execState (runReaderT (runBar m) r) 131 | 132 | ----------------------------------------------------------------------------- 133 | 134 | type Location = (Double,Double) 135 | type Orientation = Double -- angle 136 | type Head = Bool 137 | type Fill = Bool 138 | 139 | data AnnoteType = Arrow | Glyph | Text | Oval | Rectangle | Cairo 140 | 141 | -- extra glyphs and so on that can be put in a chart 142 | data Annotation = AnnArrow Head LineType Location Location 143 | | AnnOval Fill BarType Location Location 144 | | AnnRect Fill BarType Location Location 145 | | AnnGlyph PointType Location 146 | | AnnText TextEntry Location --Orientation 147 | | AnnCairo (Double -> Double -> Double -> Double -> C.Render ()) 148 | 149 | type Annotations = [Annotation] 150 | 151 | ----------------------------------------------------------------------------- 152 | 153 | newtype Annote a = FN { runAnnote :: ReaderT Options (State Annotations) a} 154 | deriving(Monad, Functor, Applicative, MonadReader Options, MonadState Annotations) 155 | 156 | execAnnote :: Annote a -> Options -> Annotations -> Annotations 157 | execAnnote m r = execState (runReaderT (runAnnote m) r) 158 | 159 | ----------------------------------------------------------------------------- 160 | 161 | data Scale = Linear | Log deriving(Eq) 162 | 163 | data Range = Range { _range_scale :: Scale, 164 | _range_min :: Double, 165 | _range_max :: Double } 166 | 167 | data Ranges = Ranges (Either Range (Range,Range)) (Either Range (Range,Range)) 168 | 169 | getRanges :: AxisType -> AxisSide -> Ranges -> (Scale,Double,Double) 170 | getRanges XAxis Lower (Ranges (Left (Range scale xmin xmax)) _) = 171 | (scale,xmin,xmax) 172 | getRanges XAxis Lower (Ranges (Right (Range scale xmin xmax,_)) _) = 173 | (scale,xmin,xmax) 174 | getRanges XAxis Upper (Ranges (Right (_,Range scale xmin xmax)) _) = 175 | (scale,xmin,xmax) 176 | getRanges XAxis Upper (Ranges (Left _) _) = 177 | error "no upper range defined" 178 | getRanges YAxis Lower (Ranges _ (Left (Range scale ymin ymax))) = 179 | (scale,ymin,ymax) 180 | getRanges YAxis Lower (Ranges _ (Right (Range scale ymin ymax,_))) = 181 | (scale,ymin,ymax) 182 | getRanges YAxis Upper (Ranges _ (Right (_,Range scale ymin ymax))) = 183 | (scale,ymin,ymax) 184 | getRanges YAxis Upper (Ranges _ (Left _)) = 185 | error "no upper range defined" 186 | 187 | ----------------------------------------------------------------------------- 188 | 189 | data AxisType = XAxis | YAxis deriving(Eq) 190 | data AxisSide = Lower | Upper deriving(Eq) 191 | data AxisPosn = Side AxisSide 192 | | Value Double 193 | deriving(Eq) 194 | 195 | data Tick = Minor | Major deriving(Eq) 196 | 197 | type GridLines = Bool 198 | 199 | data TickValues = TickNumber Int 200 | | TickValues (Vector Double) 201 | 202 | data Ticks = Ticks LineType TickValues 203 | 204 | setTickGridlines :: LineType -> Maybe Ticks -> Maybe Ticks 205 | setTickGridlines gl (Just (Ticks _ tv)) = Just $ Ticks gl tv 206 | setTickGridlines _ Nothing = Nothing 207 | 208 | setTickValues :: TickValues -> Maybe Ticks -> Maybe Ticks 209 | setTickValues tv (Just (Ticks gl _)) = Just $ Ticks gl tv 210 | setTickValues tv Nothing = Just $ Ticks NoLine tv 211 | 212 | data TickFormat 213 | = DefaultTickFormat 214 | | Printf String 215 | | FormatFunction (Double -> String) 216 | 217 | data AxisData = Axis { 218 | _axis_type :: AxisType 219 | , _position :: AxisPosn 220 | , _line_type :: LineType 221 | , _minor_ticks :: Maybe Ticks 222 | , _major_ticks :: Maybe Ticks 223 | , _tick_format :: TickFormat 224 | , _tick_labels :: [TextEntry] 225 | , _label :: TextEntry 226 | } 227 | -- want line styles, so that, e.g., axes in centre of chart are grey or dashed etc. 228 | 229 | ----------------------------------------------------------------------------- 230 | 231 | newtype Axis a = FA { runAxis :: ReaderT Options (State AxisData) a} 232 | deriving(Monad, Functor, Applicative, MonadReader Options, MonadState AxisData) 233 | 234 | execAxis :: Axis a -> Options -> AxisData -> AxisData 235 | execAxis m r = execState (runReaderT (runAxis m) r) 236 | 237 | ----------------------------------------------------------------------------- 238 | 239 | type LegendBorder = Bool 240 | 241 | data LegendLocation = North | NorthEast | East | SouthEast | South 242 | | SouthWest | West | NorthWest 243 | deriving(Eq) 244 | data LegendOrientation = Inside | Outside 245 | 246 | -- need to have same number of entries as data series 247 | data LegendData = Legend { 248 | _bounded :: Bool -- is there a box around the legend? 249 | , _location :: LegendLocation 250 | , _orient :: LegendOrientation 251 | , _leg_fmt :: TextOptions 252 | } 253 | -- do we want a toggle for legends so the labels don't get destroyed? 254 | 255 | ----------------------------------------------------------------------------- 256 | 257 | newtype Legend a = FE { runLegend :: ReaderT TextOptions (State (Maybe LegendData)) a} 258 | deriving(Monad, Functor, Applicative, MonadReader TextOptions, MonadState (Maybe LegendData)) 259 | 260 | execLegend :: Legend a -> TextOptions -> (Maybe LegendData) -> (Maybe LegendData) 261 | execLegend m r = execState (runReaderT (runLegend m) r) 262 | 263 | ----------------------------------------------------------------------------- 264 | 265 | -- simply padding for left, right, bottom, and top 266 | data Padding = Padding Double Double Double Double 267 | 268 | ----------------------------------------------------------------------------- 269 | 270 | data Options = Options { 271 | _lineoptions :: LineOptions 272 | , _pointoptions :: PointOptions 273 | , _baroptions :: BarOptions 274 | , _textoptions :: TextOptions 275 | } 276 | 277 | ----------------------------------------------------------------------------- 278 | 279 | data SeriesType = Line | Point | LinePoint | Impulse | Step | Area 280 | | Bar | Hist | Candle | Whisker 281 | 282 | ----------------------------------------------------------------------------- 283 | 284 | type Series = Vector Double 285 | type Surface = Matrix Double 286 | type ErrorSeries = Series 287 | type MinMaxSeries = (Series,Series) 288 | type Function = Double -> Double 289 | type VectorFunction = Vector Double -> Vector Double 290 | 291 | type SeriesLabel = String 292 | 293 | --instance Show Function where show _ = "<>" 294 | 295 | data OrdSeries = Plain Series 296 | | Error Series (Either ErrorSeries (ErrorSeries,ErrorSeries)) 297 | | MinMax MinMaxSeries (Maybe (ErrorSeries,ErrorSeries)) 298 | 299 | getOrdData :: OrdSeries -> Series 300 | getOrdData (Plain o) = o 301 | getOrdData (Error o _) = o 302 | getOrdData (MinMax (o,_) _) = o 303 | 304 | getMinMaxData :: OrdSeries -> Either MinMaxSeries (MinMaxSeries,(ErrorSeries,ErrorSeries)) 305 | getMinMaxData (Plain _) = error "Unreachable code, not MinMax" 306 | getMinMaxData (Error _ _) = error "Unreachable code, not MinMax" 307 | getMinMaxData (MinMax o Nothing) = Left o 308 | getMinMaxData (MinMax o (Just e)) = Right (o,e) 309 | 310 | type MonotoneIncreasing = Bool 311 | 312 | type AbsFunctionModifier = (Double -> Double) 313 | 314 | data Abscissae = AbsFunction AbsFunctionModifier 315 | | AbsPoints MonotoneIncreasing Series 316 | 317 | data Ordinates = OrdFunction AxisSide VectorFunction (Maybe SeriesLabel) 318 | | OrdPoints AxisSide OrdSeries (Maybe SeriesLabel) 319 | 320 | getOrdLabel :: Ordinates -> (Maybe SeriesLabel) 321 | getOrdLabel (OrdFunction _ _ sl) = sl 322 | getOrdLabel (OrdPoints _ _ sl) = sl 323 | 324 | isLower :: Ordinates -> Bool 325 | isLower (OrdFunction Lower _ _) = True 326 | isLower (OrdPoints Lower _ _) = True 327 | isLower _ = False 328 | 329 | isUpper :: Ordinates -> Bool 330 | isUpper = not . isLower 331 | 332 | data Decoration = DecLine LineType 333 | | DecPoint PointType 334 | | DecLinPt LineType PointType 335 | | DecImpulse LineType 336 | | DecStep LineType 337 | | DecArea LineType 338 | | DecBar BarType 339 | | DecHist BarType 340 | | DecCand BarType 341 | | DecWhisk BarType 342 | 343 | isHist :: Decoration -> Bool 344 | isHist (DecLine _) = False 345 | isHist (DecPoint _) = False 346 | isHist (DecLinPt _ _) = False 347 | isHist (DecImpulse _) = False 348 | isHist (DecStep _) = False 349 | isHist (DecArea _) = False 350 | isHist (DecBar _) = False 351 | isHist (DecHist _) = True 352 | isHist (DecCand _) = False 353 | isHist (DecWhisk _) = False 354 | 355 | decorationGetLineType :: Decoration -> Maybe LineType 356 | decorationGetLineType (DecLine lt) = Just lt 357 | decorationGetLineType (DecPoint _) = Nothing 358 | decorationGetLineType (DecLinPt lt _) = Just lt 359 | decorationGetLineType (DecImpulse lt) = Just lt 360 | decorationGetLineType (DecStep lt) = Just lt 361 | decorationGetLineType (DecArea lt) = Just lt 362 | decorationGetLineType (DecBar _) = Nothing 363 | decorationGetLineType (DecHist _) = Nothing 364 | decorationGetLineType (DecCand _) = Nothing 365 | decorationGetLineType (DecWhisk _) = Nothing 366 | 367 | decorationGetPointType :: Decoration -> Maybe PointType 368 | decorationGetPointType (DecLine _) = Nothing 369 | decorationGetPointType (DecPoint pt) = Just pt 370 | decorationGetPointType (DecLinPt _ pt) = Just pt 371 | decorationGetPointType (DecImpulse _) = Nothing 372 | decorationGetPointType (DecStep _) = Nothing 373 | decorationGetPointType (DecArea _) = Nothing 374 | decorationGetPointType (DecBar _) = Nothing 375 | decorationGetPointType (DecHist _) = Nothing 376 | decorationGetPointType (DecCand _) = Nothing 377 | decorationGetPointType (DecWhisk _) = Nothing 378 | 379 | decorationGetBarType :: Decoration -> Maybe BarType 380 | decorationGetBarType (DecLine _) = Nothing 381 | decorationGetBarType (DecPoint _) = Nothing 382 | decorationGetBarType (DecLinPt _ _) = Nothing 383 | decorationGetBarType (DecImpulse _) = Nothing 384 | decorationGetBarType (DecStep _) = Nothing 385 | decorationGetBarType (DecArea _) = Nothing 386 | decorationGetBarType (DecBar bt) = Just bt 387 | decorationGetBarType (DecHist bt) = Just bt 388 | decorationGetBarType (DecCand bt) = Just bt 389 | decorationGetBarType (DecWhisk bt) = Just bt 390 | 391 | data DecoratedSeries = DecSeries Ordinates Decoration 392 | -- BarSeries Abscissae Ordinates BarType 393 | 394 | data DataSeries = DS_Y (A.Array Int DecoratedSeries) 395 | | DS_1toN Abscissae (A.Array Int DecoratedSeries) 396 | | DS_1to1 (A.Array Int (Abscissae,DecoratedSeries)) 397 | | DS_Surf Surface 398 | 399 | ----------------------------------------------------------------------------- 400 | 401 | newtype Data a = FD { runData :: SupplyT SupplyData (ReaderT Options (State DataSeries)) a } 402 | deriving(Monad, Functor, Applicative, MonadSupply SupplyData, MonadReader Options, MonadState DataSeries) 403 | 404 | execData :: Data a -> SupplyData -> Options -> DataSeries -> DataSeries 405 | execData m r s = execState (runReaderT (runSupplyT (runData m) r) s) 406 | 407 | type FormattedSeries = Data DecoratedSeries 408 | 409 | ----------------------------------------------------------------------------- 410 | 411 | type Border = Bool 412 | 413 | ----------------------------------------------------------------------------- 414 | 415 | data SupplyData = SupplyData { 416 | _colours :: [Color] 417 | , _glyphs :: [Glyph] 418 | } 419 | 420 | instance Supply SupplyData Color where 421 | nextSupply (SupplyData [] _ ) = error "Empty supply" 422 | nextSupply (SupplyData (c:cs) gs) = (c,SupplyData cs gs) 423 | instance Supply SupplyData Glyph where 424 | nextSupply (SupplyData _ []) = error "Empty supply" 425 | nextSupply (SupplyData cs (g:gs)) = (g,SupplyData cs gs) 426 | 427 | ----------------------------------------------------------------------------- 428 | 429 | data BarSetting = BarNone | BarSpread | BarStack 430 | 431 | ----------------------------------------------------------------------------- 432 | 433 | type SampleData = Bool 434 | 435 | ----------------------------------------------------------------------------- 436 | 437 | -- | a plot 438 | data PlotData = Plot { 439 | _border :: Border 440 | , _back_colr :: Color 441 | , _plot_pads :: Padding 442 | , _heading :: TextEntry 443 | , _ranges :: Ranges 444 | , _axes :: [AxisData] 445 | , _barconfig :: BarSetting 446 | , _sampledata :: SampleData 447 | , _data :: DataSeries 448 | , _legend :: Maybe LegendData 449 | , _annote :: Annotations 450 | } 451 | 452 | ----------------------------------------------------------------------------- 453 | 454 | type Plots = A.Array (Int,Int) (Maybe PlotData) 455 | 456 | ----------------------------------------------------------------------------- 457 | 458 | newtype Plot a = FP { runPlot :: SupplyT SupplyData (ReaderT Options (State PlotData)) a } 459 | deriving(Monad, Functor, Applicative, MonadReader Options, MonadSupply SupplyData, MonadState PlotData) 460 | 461 | execPlot :: Plot a -> SupplyData -> Options -> PlotData -> PlotData 462 | execPlot m s r = execState (runReaderT (runSupplyT (runPlot m) s) r) 463 | 464 | ----------------------------------------------------------------------------- 465 | 466 | dataInPlot' :: State DataSeries a -> State PlotData a 467 | dataInPlot' m = state $ \s -> let (a,d') = runState m (_data s) 468 | in (a,s { _data = d'}) 469 | 470 | dataInPlot :: Data a -> Plot a 471 | dataInPlot m = FP $ mapSupplyT (mapReaderT dataInPlot') (runData m) 472 | 473 | ----------------------------------------------------------------------------- 474 | 475 | legendInPlot' :: State (Maybe LegendData) a -> State PlotData a 476 | legendInPlot' m = state $ \s -> let l = _legend s 477 | (a,legend) = runState m l 478 | in (a,s { _legend = legend}) 479 | 480 | legendInPlot :: Legend a -> Plot a 481 | legendInPlot m = FP $ lift $ (withReaderT _textoptions . mapReaderT legendInPlot') (runLegend m) 482 | 483 | ----------------------------------------------------------------------------- 484 | 485 | annoteInPlot' :: State Annotations a -> State PlotData a 486 | annoteInPlot' m = state $ \s -> let l = _annote s 487 | (a,annote) = runState m l 488 | in (a,s { _annote = annote}) 489 | 490 | annoteInPlot :: Annote a -> Plot a 491 | annoteInPlot m = FP $ lift $ (mapReaderT annoteInPlot') (runAnnote m) 492 | 493 | ----------------------------------------------------------------------------- 494 | 495 | -- | a chart has a title and contains one or more plots 496 | data FigureData = Figure { 497 | _back_clr :: Color 498 | , _fig_pads :: Padding 499 | , _title :: TextEntry 500 | , _subtitle :: TextEntry 501 | , _plots :: Plots 502 | } 503 | 504 | ----------------------------------------------------------------------------- 505 | 506 | data FigureState = FigureState { 507 | _defaults :: Options 508 | , _supplies :: SupplyData 509 | , _figure :: FigureData 510 | } 511 | 512 | newtype Figure a = FC { runFigure :: State FigureState a } 513 | deriving(Monad, Functor, Applicative, MonadState FigureState) 514 | 515 | ----------------------------------------------------------------------------- 516 | 517 | execFigure :: Figure a -> FigureState -> FigureState 518 | execFigure g = execState (runFigure g) 519 | 520 | getFigure :: Figure FigureData 521 | getFigure = gets _figure 522 | 523 | getDefaults :: Figure Options 524 | getDefaults = gets _defaults 525 | 526 | getSupplies :: Figure SupplyData 527 | getSupplies = gets _supplies 528 | 529 | putFigure :: FigureData -> Figure () 530 | putFigure p = modify $ \s -> s { _figure = p } 531 | 532 | putDefaults :: Options -> Figure () 533 | putDefaults p = modify $ \s -> s { _defaults = p } 534 | 535 | putSupplies :: SupplyData -> Figure () 536 | putSupplies p = modify $ \s -> s { _supplies = p } 537 | 538 | modifyFigure :: (FigureData -> FigureData) -> Figure () 539 | modifyFigure m = modify $ \s -> s { _figure = m (_figure s) } 540 | 541 | modifyDefaults :: (Options -> Options) -> Figure () 542 | modifyDefaults m = modify $ \s -> s { _defaults = m (_defaults s) } 543 | 544 | ----------------------------------------------------------------------------- 545 | {-TODO 546 | * eeglab-like data offset in channels up x-axis 547 | -} 548 | ----------------------------------------------------------------------------- 549 | --------------------------------------------------------------------------------