plot (empty) → 0.1
raw patch · 29 files changed
+5260/−0 lines, 29 filesdep +MaybeTdep +arraydep +basesetup-changedbinary-added
Dependencies added: MaybeT, array, base, base-unicode-symbols, cairo, colour, hmatrix, mtl, pango
Files
- CHANGES +2/−0
- LICENSE +27/−0
- README +65/−0
- Setup.lhs +3/−0
- examples/perturbed-sine.hs +92/−0
- examples/perturbed-sine.png binary
- lib/Control/Monad/Supply.hs +116/−0
- lib/Graphics/Rendering/Plot.hs +109/−0
- lib/Graphics/Rendering/Plot/Defaults.hs +215/−0
- lib/Graphics/Rendering/Plot/Figure.hs +269/−0
- lib/Graphics/Rendering/Plot/Figure/Bar.hs +120/−0
- lib/Graphics/Rendering/Plot/Figure/Line.hs +136/−0
- lib/Graphics/Rendering/Plot/Figure/Plot.hs +259/−0
- lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs +82/−0
- lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs +714/−0
- lib/Graphics/Rendering/Plot/Figure/Plot/Legend.hs +58/−0
- lib/Graphics/Rendering/Plot/Figure/Point.hs +119/−0
- lib/Graphics/Rendering/Plot/Figure/Simple.hs +152/−0
- lib/Graphics/Rendering/Plot/Figure/Text.hs +181/−0
- lib/Graphics/Rendering/Plot/Render.hs +173/−0
- lib/Graphics/Rendering/Plot/Render/Plot.hs +129/−0
- lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs +445/−0
- lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +403/−0
- lib/Graphics/Rendering/Plot/Render/Plot/Glyph.hs +163/−0
- lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs +305/−0
- lib/Graphics/Rendering/Plot/Render/Text.hs +151/−0
- lib/Graphics/Rendering/Plot/Render/Types.hs +213/−0
- lib/Graphics/Rendering/Plot/Types.hs +465/−0
- plot.cabal +94/−0
+ CHANGES view
@@ -0,0 +1,2 @@+0.1:+ * initial version
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) A. V. H. McPhail 2010++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of other contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README view
@@ -0,0 +1,65 @@+THIS README COPIED FROM THE diagrams PACKAGE++Graphics.Rendering.Plot provides an embedded domain-specific+language (EDSL) for creating plots rendered with Cairo++For some examples of use, see http://code.haskell.org/plot/examples .++------------------------------------------------------------------------++To install the Plots library:++1. Get the dependencies++ The plots library uses Haskell bindings to the Cairo vector+ graphics library. In order to build the plots library, you+ will first need the following:++ * The Cairo library itself. This is probably available through+ your system's package manager and may even already be installed.+ On Ubuntu, for example, it is available from the 'libcairo'+ package.++ * The Haskell cairo bindings, which are packaged as part of+ gtk2hs. Unfortunately, for various technical reasons, gtk2hs is+ not cabalized and cannot be downloaded and installed from+ Hackage. To get gtk2hs you will need to go to the gtk2hs+ website (http://www.haskell.org/gtk2hs/) and follow the+ instructions to download and build it.++ * The colour library, which is available from Hackage. If you use+ the cabal-install build option described below, the colour+ library will be downloaded and installed for you automatically.++2. Build++ * Option 1: use cabal-install++ If you have cabal-install, *after* installing gtk2hs, you can+ install plots and the remaining dependencies with+ cabal-install:++ cabal install plot++ Optionally, you can also pass options such as --user+ --prefix=$HOME to install locally.++ * Option 2: manual build++ Once all the dependencies are built and installed, you can build+ and install plots as follows:+ + runhaskell Setup.lhs configure --prefix=$HOME --user+ runhaskell Setup.lhs build+ runhaskell Setup.lhs install++ (Optionally, you can omit the --prefix and --user arguments to the+ configure step, and run the install step with 'sudo' in order to+ install the library systemwide.)++3. Building Haddock documentation (recommended)++ runhaskell Setup.lhs haddock++ Once the documentation has been built, you can access it by + pointing your browser to dist/doc/html/plot/index.html.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ examples/perturbed-sine.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverlappingInstances #-}+-- thanks to http://www.muitovar.com/gtk2hs/app1.html++--module Test where++import Control.Concurrent+import Control.Concurrent.MVar++import Control.Monad.Trans++import Graphics.UI.Gtk hiding(Circle,Cross)+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++import Data.Colour.Names++import Data.Packed.Vector+--import Data.Packed.Random+import Data.Packed()++import qualified Data.Array.IArray as A++import Numeric.LinearAlgebra.Linear+--import Numeric.LinearAlgebra.Instances+--import Numeric.LinearAlgebra.Interface++import Numeric.GSL.Statistics++import Graphics.Rendering.Plot++import Debug.Trace++ln = 25+ts = linspace ln (0,1)+rs = ln |> take ln [0.306399512330476,-0.4243863460546792,-0.20454667402138094,-0.42873761654774106,1.3054721019673694,0.6474765138733175,1.1942346875362946,-1.7404737823144103,0.2607101951530985,-0.26782584645524893,-0.31403631431884504,3.365508546473985e-2,0.6147856889630383,-1.191723225061435,-1.9933460981205509,0.6015225906539229,0.6394073044477114,-0.6030919788928317,0.1832742199706381,0.35532918011648473,0.1982646055874545,1.7928383756822786,-9.992760294442601e-2,-1.401166614128362,-1.1088031929569364,-0.827319908453775,1.0406363628775428,-0.3070345979284644,0.6781735212645198,-0.8431706723519456,-0.4245730055085966,-0.6503687925251668,-1.4775567962221399,0.5587634921497298,-0.6481020127107823,7.313441602898768e-2,0.573580543636529,-0.9036472376122673,2.650805059813826,9.329324044673039e-2,1.9133487025468563,-1.5366337588254542,-1.0159359710920388,7.95982933517428e-2,0.5813673663649735,-6.93329631989878e-2,1.1024137719307867,-0.6046286796589855,-0.8812842030098401,1.4612246471009083,0.9584060744500491,9.210899579679932e-2,-0.15850413664405813,-0.4754694827227343,0.8669922262489788,0.4593351854708853,-0.2015350278936992,0.8829710664887649,0.7195048491420026]++ss = sin (15*2*pi*ts)+ds = 0.25*rs + ss+es = constant (0.25*(stddev rs)) ln++fs :: Double -> Double+fs = sin . (15*2*pi*)++figure = do+ withTextDefaults $ setFontFamily "OpenSymbol"+ withTitle $ setText "Testing plot package:"+ withSubTitle $ do+ setText "with 1 second of a 15Hz sine wave"+ setFontSize 10+ setPlots 1 1+ withPlot (1,1) $ do+ setDataset (ts,[point (ds,es) (Cross,red),line fs blue])+ addAxis XAxis (Side Lower) $ withAxisLabel $ setText "time (s)"+ addAxis YAxis (Side Lower) $ withAxisLabel $ setText "amplitude"+ addAxis XAxis (Value 0) $ return ()+ setRangeFromData XAxis Lower+ setRange YAxis Lower (-1.25) 1.25++display :: ((Int,Int) -> C.Render ()) -> IO ()+display r = do+ initGUI -- is start++ window <- windowNew+ set window [ windowTitle := "Cairo test window"+ , windowDefaultWidth := 400+ , windowDefaultHeight := 300+ , containerBorderWidth := 1+ ]++-- canvas <- pixbufNew ColorspaceRgb True 8 300 200+-- containerAdd window canvas+ frame <- frameNew+ containerAdd window frame+ canvas <- drawingAreaNew+ containerAdd frame canvas+ widgetModifyBg canvas StateNormal (Color 65535 65535 65535)++ widgetShowAll window ++ on canvas exposeEvent $ tryEvent $ do s <- liftIO $ widgetGetSize canvas+ drw <- liftIO $ widgetGetDrawWindow canvas+ --dat <- liftIO $ takeMVar d+ --liftIO $ renderWithDrawable drw (circle 50 10)+ liftIO $ renderWithDrawable drw (r s)++ onDestroy window mainQuit+ mainGUI++ +main = display $ render figure++test = writeFigure PNG "perturbed-sine.png" (400,400) figure
+ examples/perturbed-sine.png view
binary file changed (absent → 38208 bytes)
+ lib/Control/Monad/Supply.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : Control.Monad.Supply+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- a monad that supplies the next value+--+-----------------------------------------------------------------------------++module Control.Monad.Supply (+ Supply(..)+ , MonadSupply(..)+ , supplyN+ , SupplyT(..), evalSupplyT, execSupplyT+ , mapSupplyT+ ) where++-----------------------------------------------------------------------------++import Control.Monad.Writer+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Trans()++-----------------------------------------------------------------------------++class Supply a b where+ nextSupply :: a -> (b,a)++{-+instance Supply [a] a where nextSupply (x:xs) = (x,xs)+instance Supply ([a],[b]) a where nextSupply ((x:xs),ys) = (x,(xs,ys))+instance Supply ([a],[b]) b where nextSupply (xs,(y:ys)) = (y,(xs,ys))+-}+-----------------------------------------------------------------------------++class Monad m => MonadSupply s m | m -> s where+ supply :: Supply s a => m a++supplyN :: (MonadSupply s m, Supply s a) => Int -> m [a]+supplyN n = replicateM n supply++-----------------------------------------------------------------------------++newtype SupplyT s m a = SupplyT { runSupplyT :: s -> m (a, s) }+ +evalSupplyT :: Monad m => SupplyT s m a -> s -> m a+evalSupplyT st s = do+ ~(a,_) <- runSupplyT st s+ return a++execSupplyT :: Monad m => SupplyT s m a -> s -> m s+execSupplyT st s = do+ ~(_,s') <- runSupplyT st s+ return s'++mapSupplyT :: (m (a,s) -> n (b,s)) -> SupplyT s m a -> SupplyT s n b+mapSupplyT f st = SupplyT $ f . runSupplyT st++-----------------------------------------------------------------------------++instance Monad m => Functor (SupplyT s m) where+ fmap f m = SupplyT $ \s -> do+ ~(x, s') <- runSupplyT m s+ return (f x,s')++instance Monad m => Monad (SupplyT s m) where+ return a = SupplyT $ \s -> return (a, s) + m >>= f = SupplyT $ \s -> do+ ~(a,s') <- runSupplyT m s+ runSupplyT (f a) s'+ fail str = SupplyT $ \_ -> fail str+ +instance MonadTrans (SupplyT s) where+ lift m = SupplyT $ \s -> do+ a <- m+ return (a,s)++instance Monad m => MonadSupply s (SupplyT s m) where+ supply = SupplyT $ \s -> return $ nextSupply s++-----------------------------------------------------------------------------+{-+instance (Monad (t m), MonadSupply s m, MonadTrans t) => MonadSupply s (t m) where+ supply = lift supply+-}+-----------------------------------------------------------------------------++instance MonadState s m => MonadState s (SupplyT s' m) where+ get = lift get+ put = lift . put++instance MonadReader r m => MonadReader r (SupplyT s m) where+ ask = lift ask+ local f m = SupplyT $ \s -> local f (runSupplyT m s)++instance MonadWriter w m => MonadWriter w (SupplyT s m) where+ tell = lift . tell+ listen m = SupplyT $ \s -> do+ ~((a,s'),w) <- listen (runSupplyT m s)+ return ((a,w),s')+ pass m = SupplyT $ \s -> pass $ do+ ~((a,f),s') <- runSupplyT m s+ return ((a,s'),f)++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot.hs view
@@ -0,0 +1,109 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Graphical plots+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot (+ -- * Re-exported for convenience+ module Graphics.Rendering.Plot.Figure.Simple+ , module Graphics.Rendering.Plot.Figure+ , module Graphics.Rendering.Plot.Render+ -- * Example+ -- $example+ ) where+++-----------------------------------------------------------------------------++import Graphics.Rendering.Plot.Figure.Simple+import Graphics.Rendering.Plot.Figure+import Graphics.Rendering.Plot.Render++-----------------------------------------------------------------------------+{- $example++Create some data:++> ln = 25+> ts = linspace ln (0,1)+> rs = randomVector 0 Gaussian ln+> +> ss = sin (15*2*pi*ts)+> ds = 0.25*rs + ss+> es = constant (0.25*(stddev rs)) ln+> +> fs :: Double -> Double+> fs = sin . (15*2*pi*)++Perform actions in 'Figure a' to create a figure++> test_graph = do+> withTextDefaults $ setFontFamily "OpenSymbol"+> withTitle $ setText "Testing plot package:"+> withSubTitle $ do+> setText "with 1 second of a 15Hz sine wave"+> setFontSize 10+> setPlots 1 1+> withPlot (1,1) $ do+> setDataset (ts,[point (ds,es) (Cross,red),line fs blue])+> addAxis XAxis (Side Lower) $ withAxisLabel $ setText "time (s)"+> addAxis YAxis (Side Lower) $ withAxisLabel $ setText "amplitude"+> addAxis XAxis (Value 0) $ return ()+> setRangeFromData XAxis Lower+> setRange YAxis Lower (-1.25) 1.25+ +Render the graph to a Cairo 'Render ()' action that takes the width+and height of the drawing area++> test_render :: (Double,Double) -> Render ()+> test_render = render test_graph++The same graph using the 'Simple' interface++> test_graph2 = do+> plot (ts,[point (ds,es) (Cross,red),line fs blue])+> title "Testing plot package:"+> subtitle "with 1 second of a 15Hz sine wave"+> xlabel "time (s)"+> ylabel "amplitude"+> yrange (-1.25) 1.25++The 'Render a' action can be used in GTK or with Cairo to write to file in PS, PDF, SVG, or PNG++Display a greyscale matrix++> ms :: Matrix Double+> ms = buildMatrix 64 64 (\(x,y) -> sin (2*2*pi*(fromIntegral x)/64) * cos (5*2*pi*(fromIntegral y)/64))++> mat_fig = do+> setPlots 1 1+> withPlot (1,1) $ do +> setDataset ms+> addAxis XAxis (Side Lower) $ setTickLabelFormat "%.0f"+> addAxis YAxis (Side Lower) $ setTickLabelFormat "%.0f"+> setRangeFromData XAxis Lower+> setRangeFromData YAxis Lower++The ODE example from hmatrix:++> import Numeric.GSL+> import Numeric.LinearAlgebra++> xdot t [x,v] = [v, -0.95*x - 0.1*v]+> ts = linspace 100 (0,20)+> sol = odeSolve xdot [10,0] ts++> ode_fig = plot (Line,ts,[sol])++-}++-----------------------------------------------------------------------------
+ lib/Graphics/Rendering/Plot/Defaults.hs view
@@ -0,0 +1,215 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Defaults+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Default values+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Defaults where++-----------------------------------------------------------------------------++import Data.Colour.Names++import qualified Data.Array.IArray as A++import qualified Graphics.Rendering.Pango as P++import Graphics.Rendering.Plot.Figure.Text++import Graphics.Rendering.Plot.Types++-----------------------------------------------------------------------------++defaultXAxisSideLowerRange :: (Double,Double)+defaultXAxisSideLowerRange = (-1,1)++-----------------------------------------------------------------------------++defaultColourList :: [Color]+defaultColourList = [blue,red,green,yellow,violet,sienna,royalblue+ ,pink,tomato,lavender,cyan,crimson,darkgreen+ ,cadetblue,darkred,yellowgreen]+ ++ defaultColourList++-----------------------------------------------------------------------------++defaultGlyphList :: [Glyph]+defaultGlyphList = [Box, Diamond, Asterisk, Triangle, Circle] + ++ defaultGlyphList++-----------------------------------------------------------------------------++defaultPointOptions :: PointOptions+defaultPointOptions = PointOptions 1 black++defaultGlyph :: Glyph+defaultGlyph = Circle++defaultPointType :: PointType+defaultPointType = FullPoint defaultPointOptions defaultGlyph++-----------------------------------------------------------------------------++defaultDashStyle :: DashStyle+defaultDashStyle = []++defaultLineWidth :: LineWidth+defaultLineWidth = 1++defaultLineOptions :: LineOptions+defaultLineOptions = LineOptions defaultDashStyle defaultLineWidth++defaultLineType :: LineType+defaultLineType = ColourLine black++-----------------------------------------------------------------------------++defaultBarWidth :: Double+defaultBarWidth = 5++defaultBarBorderWidth :: Double+defaultBarBorderWidth = 1++defaultBarBorderColour :: Color+defaultBarBorderColour = black++defaultBarOptions :: BarOptions+defaultBarOptions = BarOptions defaultBarWidth defaultBarBorderWidth defaultBarBorderColour++defaultBarType :: BarType+defaultBarType = ColourBar red++-----------------------------------------------------------------------------++defaultFontFamily :: FontFamily +defaultFontFamily = "Sans"+ +defaultFontStyle :: P.FontStyle+defaultFontStyle = P.StyleNormal++defaultFontVariant :: P.Variant+defaultFontVariant = P.VariantNormal++defaultFontWeight :: P.Weight+defaultFontWeight = P.WeightNormal++defaultFontStretch :: P.Stretch+defaultFontStretch = P.StretchNormal++defaultFontOptions :: FontOptions +defaultFontOptions = FontOptions defaultFontFamily defaultFontStyle defaultFontVariant+ defaultFontWeight defaultFontStretch++defaultFontSize :: Double+defaultFontSize = 16++defaultFontColour :: Color+defaultFontColour = black++defaultTextOptions :: TextOptions+defaultTextOptions = TextOptions defaultFontOptions defaultFontSize defaultFontColour++-----------------------------------------------------------------------------++defaultBounding :: BoundingBox+defaultBounding = BoundingBox 0 0 1 1++-----------------------------------------------------------------------------++defaultRanges :: Double -> Double -> Double -> Double -> Ranges+defaultRanges xmin xmax ymin ymax = Ranges (Left (Range Linear xmin xmax)) (Left (Range Linear ymin ymax))++-----------------------------------------------------------------------------++zeroPadding, defaultPadding, defaultFigurePadding, defaultPlotPadding :: Padding+zeroPadding = Padding 0 0 0 0+defaultPadding = Padding 10 10 10 10 +defaultFigurePadding = Padding 10 10 10 10+defaultPlotPadding = Padding 10 10 10 10++-----------------------------------------------------------------------------++solid, empty :: Solid+solid = True+empty = False++-----------------------------------------------------------------------------++defaultOptions :: Options+defaultOptions = Options defaultLineOptions + defaultPointOptions + defaultBarOptions+ defaultTextOptions++-----------------------------------------------------------------------------++minorTickLength, majorTickLength, tickLabelScale :: Double+minorTickLength = 5.0+majorTickLength = 7.0+tickLabelScale = 0.75++defaultMinorTicks :: Ticks+defaultMinorTicks = Ticks False (Left 41)++defaultMajorTicks :: Ticks+defaultMajorTicks = Ticks False (Left 5)++defaultTickFormat :: TickFormat+defaultTickFormat = ""++defaultAxis :: AxisType -> AxisPosn -> AxisData+defaultAxis at axp = Axis at axp defaultLineType defaultMinorTicks defaultMajorTicks+ defaultTickFormat NoText++defaultXAxis, defaultYAxis :: AxisData+defaultXAxis = defaultAxis XAxis (Side Lower)+defaultYAxis = defaultAxis YAxis (Side Lower)++-----------------------------------------------------------------------------++defaultLegend :: LegendData+defaultLegend = Legend True East Outside (scaleFontSize legendLabelScale defaultTextOptions) ++legendLabelScale :: Double+legendLabelScale = 0.7++legendSampleWidth :: Double+legendSampleWidth = 10++-----------------------------------------------------------------------------++defaultSupply :: SupplyData+defaultSupply = SupplyData defaultColourList defaultGlyphList ++-----------------------------------------------------------------------------++emptyPlot :: PlotData+emptyPlot = Plot False defaultPlotPadding NoText (Ranges (Left (Range Linear (-1) 1)) (Left (Range Linear (-1) 1)))+ [] undefined Nothing []++-----------------------------------------------------------------------------++emptyPlots :: Plots+emptyPlots = (A.listArray ((0,0),(0,0)) [])++-----------------------------------------------------------------------------++emptyFigure :: FigureData+emptyFigure = Figure defaultFigurePadding NoText NoText emptyPlots++-----------------------------------------------------------------------------++defaultFigureState :: FigureState+defaultFigureState = FigureState undefined + defaultSupply+ undefined++-----------------------------------------------------------------------------
+ lib/Graphics/Rendering/Plot/Figure.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Creation and manipulation of 'Figure's+--+-- The same problem of leaked instances as at <http://hackage.haskell.org/packages/archive/graphviz/2999.10.0.1/doc/html/Data-GraphViz-Commands.html#t%3AGraphvizCanvas> occurs here.+--+--+-- /with/, /set/, /clear/, /new/, and /add/ are the operations that can+-- be performed on various elements of a figure.+-- +-- /glib/\//data-accessor/ abstractions (verbs/modifiers) are planned for future implementations++-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure (+ -- * Top level operation+ Figure(), FigureState()+ -- * Default options+ , withTextDefaults+ , withLineDefaults + , withPointDefaults + , withBarDefaults + -- * Figures+ , newFigure+ -- ** Formatting+ , setFigurePadding+ , withTitle+ , withSubTitle+ , setPlots+ , withPlot, withPlots + -- * Sub-plots+ , Plot()+ -- ** Plot elements + , Border+ , setBorder+ , setPlotPadding+ , withHeading+ -- ** Series data+ , Function(), Series(), ErrorSeries()+ , Surface()+ , SeriesLabel()+ , Abscissa(), Ordinate(), Dataset()+ , FormattedSeries(), SeriesType(..)+ , line, point, linepoint+ , impulse, step+ , area+ , bar+ , hist+ , setDataset+ -- ** Plot type+ , setSeriesType+ , setAllSeriesTypes+ -- ** Formatting+ , PlotFormats()+ , withSeriesFormat+ , withAllSeriesFormats+ -- * Range+ , Scale(..)+ , setRange+ , setRangeFromData+ -- * Axes+ , Axis+ , AxisType(..),AxisSide(..),AxisPosn(..)+ , clearAxes+ , clearAxis+ , addAxis+ , withAxis+ -- * Legend+ , Legend+ , LegendBorder+ , LegendLocation(..), LegendOrientation(..)+ , clearLegend+ , setLegend+ , withLegendFormat+ -- ** Formatting+ , Tick(..), TickValues, GridLines+ , setTicks+ , setGridlines+ , setTickLabelFormat+ , withAxisLabel+ , withAxisLine+ -- * Lines+ , Line(), LineFormat()+ , DashStyle,Dash(..),LineWidth+ , clearLineFormat+ , setDashStyle+ , setLineWidth+ , setLineColour+ -- * Points+ , Point(), PointFormat()+ , Glyph(..)+ , PointSize+ , setGlyph+ , setPointSize+ , setPointColour+ -- * Bars+ , Bar(), BarFormat()+ , clearBarFormat+ , setBarWidth+ , setBarColour+ , setBarBorderWidth+ , setBarBorderColour+ -- * Text labels+ , Text()+ , FontFamily,FontSize,Color+ -- | A text element must exist for formatting to work+ , clearText+ , clearTextFormat+ , setText+ , setFontFamily+ , setFontStyle+ , setFontVariant+ , setFontWeight+ , setFontStretch+ , setFontSize+ , setFontColour+ ) where++-----------------------------------------------------------------------------++--import Data.Packed.Vector+--import Numeric.LinearAlgebra.Linear++--import Data.Word+--import Data.Colour.SRGB+import Data.Colour.Names++import qualified Data.Array.IArray as A++--import qualified Graphics.Rendering.Cairo as C+--import qualified Graphics.Rendering.Pango as P++--import Control.Monad.State+--import Control.Monad.Reader++import Prelude hiding(min,max)++import Graphics.Rendering.Plot.Figure.Text+import Graphics.Rendering.Plot.Figure.Line+import Graphics.Rendering.Plot.Figure.Point+import Graphics.Rendering.Plot.Figure.Bar+import Graphics.Rendering.Plot.Figure.Plot++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults++-----------------------------------------------------------------------------++-- | perform some actions on the text defaults, must be run before other text element modifications+withTextDefaults :: Text () -> Figure ()+withTextDefaults m = do+ o <- getDefaults+ let to' = _textoptions o+ let (FontText to _) = execText m to' (FontText to' "") + modifyDefaults $ \s -> s { _textoptions = to }++-- | perform some actions on the line defaults, must be run before other line element modifications+withLineDefaults :: Line () -> Figure ()+withLineDefaults m = do+ o <- getDefaults+ let lo' = _lineoptions o+ let (TypeLine lo _) = execLine m lo' (TypeLine lo' black)+ modifyDefaults $ \s -> s { _lineoptions = lo }+ +-- | perform some actions on the point defaults, must be run before other point modifications+withPointDefaults :: Point () -> Figure ()+withPointDefaults m = do+ o <- getDefaults+ let po' = _pointoptions o+ let (FullPoint po _) = execPoint m po' (FullPoint po' defaultGlyph)+ modifyDefaults $ \s -> s { _pointoptions = po }++-- | perform some actions on the bar defaults, must be run before other point modifications+withBarDefaults :: Bar () -> Figure ()+withBarDefaults m = do+ o <- getDefaults+ let bo' = _baroptions o+ let (TypeBar bo _) = execBar m bo' (TypeBar bo' black)+ modifyDefaults $ \s -> s { _baroptions = bo }+ +-----------------------------------------------------------------------------++-- | create a new blank 'Figure'+newFigure :: Figure ()+newFigure = putFigure $ Figure defaultFigurePadding NoText NoText+ (A.listArray ((1,1),(1,1)) [Nothing]) +{-+newLineFigure :: DataSeries -- ^ the y series+ -> FigureData+newLineFigure d@(DS_1toN _ _) = let ((xmin,xmax),(ymin,ymax)) = calculateRanges d+ plot = Plot False defaultPlotPadding NoText+ (defaultRanges xmin xmax ymin ymax) + [defaultXAxis,defaultYAxis] + Nothing Line d []+ in Figure defaultFigurePadding NoText NoText+ (A.listArray ((1,1),(1,1)) [Just plot]) +-}+{-+-- | create a new 'Figure'+newFigure :: PlotType -> DataSeries -> Figure ()+newFigure Line d@(DS_1toN _ _) = putFigure $ newLineFigure d+--newFigure _ _ = error "Figure type not implemented"+-}+++-----------------------------------------------------------------------------++-- | set the padding of the figure+setFigurePadding :: Double -> Double -> Double -> Double -> Figure ()+setFigurePadding l r b t = modifyFigure $ \s -> s { _fig_pads = Padding l r b t }++-- | operate on the title+withTitle :: Text () -> Figure ()+withTitle m = do+ o <- getDefaults+ modifyFigure $ \s -> s { _title = execText m (_textoptions o) (_title s) }++-- | operate on the sub-title+withSubTitle :: Text () -> Figure ()+withSubTitle m = do+ o <- getDefaults+ modifyFigure $ \s -> s { _subtitle = execText m (_textoptions o) (_title s) }++-- | set the shape of the plots, losing all current plots+setPlots :: Int -- ^ rows+ -> Int -- ^ columns+ -> Figure ()+setPlots r c = modifyFigure $ \s -> s { _plots = A.listArray ((1,1),(r,c)) (replicate (r*c) Nothing) }++-- | perform some actions on the specified subplot+withPlot :: (Int,Int) -> Plot () -> Figure ()+withPlot i m = do+ o <- getDefaults+ s <- getSupplies+ modifyFigure $ \p -> p { _plots = let plots = _plots p+ plot' = plots A.! i+ plot = case plot' of+ Nothing -> emptyPlot+ Just p' -> p'+ -- we revert supplies to the original here+ -- since we might want the same colour+ -- order for all plots + -- HOWEVER: need a better execPlot group+ in plots A.// [(i,Just $ execPlot m s o plot)] }+ +-- | perform some actions all subplots+withPlots :: Plot () -> Figure ()+withPlots m = do+ o <- getDefaults+ s <- getSupplies+ modifyFigure $ \p -> p { _plots = let plots = _plots p+ plot p' = case p' of+ Nothing -> emptyPlot+ Just p'' -> p''+ in plots A.// map (\(i,e) -> (i,Just $ execPlot m s o (plot e))) (A.assocs plots) }+ +-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Figure/Bar.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Bar+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- 'Bar' operations+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Bar (+ Bar, BarFormat(..)+ , clearBarFormat+ , setBarWidth+ , setBarColour+ , setBarBorderWidth+ , setBarBorderColour+ , getBarColour+ ) where++-----------------------------------------------------------------------------++--import Data.Word+import Data.Colour+--import Data.Colour.Names++--import qualified Graphics.Rendering.Cairo as C+--import qualified Graphics.Rendering.Pango as P++import Control.Monad.State+import Control.Monad.Reader+import Control.Monad.Supply++import Graphics.Rendering.Plot.Types++-----------------------------------------------------------------------------++changeBarColour :: Color -> BarType -> BarType+changeBarColour c (ColourBar _) = ColourBar c+changeBarColour c (TypeBar lo _) = TypeBar lo c++clearBarFormatting :: BarType -> BarType+clearBarFormatting l@(ColourBar _) = l+clearBarFormatting (TypeBar _ c) = ColourBar c++getBarColour :: BarType -> Color+getBarColour (ColourBar c) = c+getBarColour (TypeBar _ c) = c++changeBarWidth :: Width -> BarOptions -> BarOptions+changeBarWidth w (BarOptions _ bw bc) = BarOptions w bw bc++changeBarBorderWidth :: LineWidth -> BarOptions -> BarOptions+changeBarBorderWidth bw (BarOptions w _ bc) = BarOptions w bw bc++changeBarBorderColour :: Color -> BarOptions -> BarOptions+changeBarBorderColour bc (BarOptions w bw _) = BarOptions w bw bc++-----------------------------------------------------------------------------++-- | clear the formatting of a line+clearBarFormat :: Bar ()+clearBarFormat = do+ bt <- get+ case bt of+ c@(ColourBar _) -> put c+ (TypeBar _ c) -> put $ ColourBar c++changeBarOptions :: (BarOptions -> BarOptions) -> BarType -> Bar ()+changeBarOptions o (ColourBar c) = do+ bo <- ask+ put $ TypeBar (o bo) c+changeBarOptions o (TypeBar bo c) = put $ TypeBar (o bo) c++-- | set the width of the bar+setBarWidth :: Width -> Bar ()+setBarWidth bw = get >>= changeBarOptions (changeBarWidth bw)++-- | set the colour of the bar+setBarColour :: Color -> Bar ()+setBarColour c = modify (changeBarColour c)++-- | set the width of the bar border+setBarBorderWidth :: LineWidth -> Bar ()+setBarBorderWidth bw = get >>= changeBarOptions (changeBarBorderWidth bw)++-- | set the colour of the bar border+setBarBorderColour :: Color -> Bar ()+setBarBorderColour c = get >>= changeBarOptions (changeBarBorderColour c)++-----------------------------------------------------------------------------++class BarFormat a where+ toBar :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m BarType++instance BarFormat Width where toBar w = do+ bo <- asks _baroptions+ c <- supply+ return $ TypeBar (changeBarWidth w bo) c+instance Real a => BarFormat (Colour a) where toBar c = return $ ColourBar $ colourConvert c+instance Real a => BarFormat (Width,Colour a) where toBar (w,c) = do+ bo <- asks _baroptions+ return $ TypeBar (changeBarWidth w bo) $ colourConvert c+instance Real a => BarFormat (Width,Colour a,LineWidth) where toBar (bw,c,lw) = do+ bo <- asks _baroptions+ return $ TypeBar (changeBarWidth bw $ changeBarBorderWidth lw bo) $ colourConvert c+instance (Real a, Real b) => BarFormat (Width,Colour a,Colour b) where toBar (bw,c,bc) = do+ bo <- asks _baroptions+ return $ TypeBar (changeBarWidth bw $ changeBarBorderColour (colourConvert bc) bo) $ colourConvert c+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++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Figure/Line.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Line+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- 'Text' operations+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Line (+ Line, LineFormat(..)+ , DashStyle,Dash(..),LineWidth+ , clearLineFormat+ , setDashStyle+ , setLineWidth+ , setLineColour+ , getLineColour+ ) where++-----------------------------------------------------------------------------++--import Data.Word+import Data.Colour+--import Data.Colour.Names++--import qualified Graphics.Rendering.Cairo as C+--import qualified Graphics.Rendering.Pango as P++import Control.Monad.State+import Control.Monad.Reader+import Control.Monad.Supply++import Graphics.Rendering.Plot.Types++-----------------------------------------------------------------------------++changeDashStyle :: DashStyle -> LineOptions -> LineOptions+changeDashStyle ds (LineOptions _ lw) = LineOptions ds lw++changeLineWidth :: LineWidth -> LineOptions -> LineOptions+changeLineWidth lw (LineOptions ds _) = LineOptions ds lw++{-changeLineOptions :: (LineOptions -> LineOptions) -> LineType -> LineType+changeLineOptions f (LineType ls c) = LineType (f ls) c++changeDashStyle :: DashStyle -> LineType -> LineType+changeDashStyle ds = changeLineOptions (changeDashStyleStyle ds)++changeLineWidth :: LineWidth -> LineType -> LineType+changeLineWidth lw = changeLineOptions (changeLineWidthStyle lw)+-}+changeLineColour :: Color -> LineType -> LineType+changeLineColour c NoLine = ColourLine c+changeLineColour c (ColourLine _) = ColourLine c+changeLineColour c (TypeLine lo _) = TypeLine lo c++clearLineFormatting :: LineType -> LineType+clearLineFormatting NoLine = NoLine+clearLineFormatting l@(ColourLine _) = l+clearLineFormatting (TypeLine _ c) = ColourLine c++clearLine :: LineType -> LineType+clearLine _ = NoLine++getLineColour :: LineType -> Maybe Color+getLineColour NoLine = Nothing+getLineColour (ColourLine c) = Just c+getLineColour (TypeLine _ c) = Just c++-----------------------------------------------------------------------------++-- | clear the formatting of a line+clearLineFormat :: Line ()+clearLineFormat = do+ lt <- get+ case lt of+ NoLine -> put NoLine+ c@(ColourLine _) -> put c+ (TypeLine _ c) -> put $ ColourLine c++changeLineOptions :: (LineOptions -> LineOptions) -> LineType -> Line ()+changeLineOptions o NoLine = do+ lo <- ask+ put $ TypeLine (o lo) black+changeLineOptions o (ColourLine c) = do+ lo <- ask+ put $ TypeLine (o lo) c+changeLineOptions o (TypeLine lo c) = put $ TypeLine (o lo) c++-- | change the dash style of a line+setDashStyle :: DashStyle -> Line ()+setDashStyle ds = get >>= changeLineOptions (changeDashStyle ds)++-- | change the line width of a line+setLineWidth :: LineWidth -> Line ()+setLineWidth lw = get >>= changeLineOptions (changeLineWidth lw)++-- | change the line colour of a line+setLineColour :: Color -> Line ()+setLineColour c = modify (changeLineColour c)++-----------------------------------------------------------------------------++class LineFormat a where+ toLine :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m LineType++instance Real a => LineFormat (Colour a) where toLine c = return $ ColourLine $ colourConvert c+instance LineFormat DashStyle where toLine ds = do+ lo <- asks _lineoptions+ c <- supply+ return $ TypeLine (changeDashStyle ds lo) c+instance LineFormat LineWidth where toLine lw = do+ lo <- asks _lineoptions+ c <- supply+ return $ TypeLine (changeLineWidth lw lo) c+instance Real a => LineFormat (DashStyle,Colour a) where toLine (ds,c) = do+ lo <- asks _lineoptions+ return $ TypeLine (changeDashStyle ds lo) $ colourConvert c+instance Real a => LineFormat (LineWidth,Colour a) where toLine (lw,c) = do+ lo <- asks _lineoptions+ return $ TypeLine (changeLineWidth lw lo) $ colourConvert c+instance LineFormat (DashStyle,LineWidth) where toLine (ds,lw) = do+ c <- supply+ return $ TypeLine (LineOptions ds lw) c+instance Real a => LineFormat (DashStyle,LineWidth,Colour a) where toLine (ds,lw,c) = return $ TypeLine (LineOptions ds lw) $ colourConvert c++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Figure/Plot.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE UnicodeSyntax #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Plot+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Creation and manipulation of 'Plot's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Plot (+ Plot+ -- * Plot elements + , Border+ , setBorder+ , setPlotPadding+ , withHeading+ -- * Series data+ , D.Abscissa(), D.Ordinate(), D.Dataset()+ , SeriesLabel+ , D.FormattedSeries()+ , D.line, D.point, D.linepoint+ , D.impulse, D.step+ , D.area+ , D.bar+ , D.hist+ , setDataset+ -- ** Plot type+ , setSeriesType+ , setAllSeriesTypes+ -- ** Formatting+ , D.PlotFormats(..)+ , withSeriesFormat+ , withAllSeriesFormats+ -- * Range+ , Scale(..)+ , setRange+ , setRangeFromData+ -- * Axes+ , AX.Axis+ , AxisType(..),AxisSide(..),AxisPosn(..)+ , clearAxes+ , clearAxis+ , addAxis+ , withAxis+ -- * Legend+ , L.Legend+ , LegendBorder+ , L.LegendLocation(..), L.LegendOrientation(..)+ , clearLegend+ , setLegend+ , withLegendFormat+ -- ** Formatting+ , Tick(..), TickValues, GridLines+ , AX.setTicks+ , AX.setGridlines+ , AX.setTickLabelFormat+ , AX.withAxisLabel+ , AX.withAxisLine+ ) where++-----------------------------------------------------------------------------++import Data.Eq.Unicode+import Data.Bool.Unicode+import Data.Ord.Unicode++--import Data.Packed.Vector+--import Data.Packed.Matrix+import Numeric.Container++import qualified Data.Array.IArray as A++import Control.Monad.State+import Control.Monad.Reader+--import Control.Monad.Supply++import Prelude hiding(min,max)++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults+import qualified Graphics.Rendering.Plot.Figure.Text as T+import qualified Graphics.Rendering.Plot.Figure.Plot.Data as D+import qualified Graphics.Rendering.Plot.Figure.Plot.Axis as AX+import qualified Graphics.Rendering.Plot.Figure.Plot.Legend as L++-----------------------------------------------------------------------------++-- | whether to draw a boundary around the plot area+setBorder :: Border -> Plot ()+setBorder b = modify $ \s -> s { _border = b }++-- | set the padding of the subplot+setPlotPadding :: Double -> Double -> Double -> Double -> Plot ()+setPlotPadding l r b t = modify $ \s -> s { _plot_pads = Padding l r b t }++-- | set the heading of the subplot+withHeading :: Text () -> Plot ()+withHeading m = do+ o <- asks _textoptions+ modify $ \s -> s { _heading = execText m o (_heading s) }++-----------------------------------------------------------------------------++-- | set the axis range+setRange :: AxisType -> AxisSide -> Scale → Double -> Double -> Plot ()+setRange XAxis sd sc min max = modify $ \s -> s { _ranges = setXRanges' sd (_ranges s) }+ where setXRanges' sd r+ | sc ≡ Log ∧ min <= 0 = error "non-positive logarithmic range"+ | otherwise = setXRanges sd r+ setXRanges Lower (Ranges (Left _) yr) = Ranges (Left (Range sc min max)) yr+ setXRanges Lower (Ranges (Right (_,xr)) yr) = Ranges (Right ((Range sc min max,xr))) yr+ setXRanges Upper (Ranges (Left xr) yr) = Ranges (Right (xr,Range sc min max)) yr+ setXRanges Upper (Ranges (Right (_,xr)) yr) = Ranges (Right (Range sc min max,xr)) yr+setRange YAxis sd sc min max = modify $ \s -> s { _ranges = setYRanges' sd (_ranges s) }+ where setYRanges' sd r+ | sc ≡ Log ∧ min <= 0 = error "non-positive logarithmic range"+ | otherwise = setYRanges sd r+ setYRanges Lower (Ranges xr (Left _)) = Ranges xr (Left (Range sc min max))+ setYRanges Lower (Ranges xr (Right (_,yr))) = Ranges xr (Right ((Range sc min max,yr)))+ setYRanges Upper (Ranges xr (Left yr)) = Ranges xr (Right (yr,Range sc min max))+ setYRanges Upper (Ranges xr (Right (_,yr))) = Ranges xr (Right ((Range sc min max,yr)))++-- | set the axis ranges to values based on dataset+setRangeFromData :: AxisType -> AxisSide -> Scale → Plot ()+setRangeFromData ax sd sc = do+ ds <- gets _data+ let ((xmin,xmax),(ymin,ymax)) = calculateRanges ds+ case ax of+ XAxis -> setRange ax sd sc xmin xmax+ YAxis -> setRange ax sd sc ymin ymax+ +-----------------------------------------------------------------------------++-- | clear the axes of a subplot+clearAxes :: Plot ()+clearAxes = modify $ \s -> s { _axes = [] }++-- | clear an axis of a subplot+clearAxis :: AxisType -> AxisPosn -> Plot ()+clearAxis at axp = do+ ax <- gets _axes+ modify $ \s -> s { _axes = filter (\(Axis at' axp' _ _ _ _ _) -> not (at == at' && axp == axp')) ax } ++-- | add an axis to the subplot+addAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot ()+addAxis at axp m = do+ ax' <- gets _axes+ o <- ask+ let ax = execAxis m o (defaultAxis at axp)+ modify $ \s -> s { _axes = ax : ax' }++-- | operate on the given axis+withAxis :: AxisType -> AxisPosn -> AX.Axis () -> Plot ()+withAxis at axp m = do+ axes' <- gets _axes+ o <- ask+ modify $ \s -> s { _axes = map (\a@(Axis at' ap' _ _ _ _ _) + -> if at == at' && axp == ap' then execAxis m o a else a) axes' }++-----------------------------------------------------------------------------++-- | clear the legend+clearLegend :: Plot ()+clearLegend = withLegend $ L.clearLegend++-- | set the legend location and orientation+setLegend :: L.LegendBorder -> L.LegendLocation -> L.LegendOrientation -> Plot()+setLegend b l o = withLegend $ L.setLegend b l o++-- | format the legend text+withLegendFormat :: T.Text () -> Plot ()+withLegendFormat f = withLegend $ L.withLegendFormat f++-- | operate on the legend+withLegend :: L.Legend () -> Plot ()+withLegend = legendInPlot++-----------------------------------------------------------------------------++-- | operate on the data+withData :: D.Data () -> Plot ()+withData = dataInPlot++-- | set the data series of the subplot+setDataset :: D.Dataset a => a -> Plot ()+setDataset d = withData $ D.setDataSeries d++-- | set the plot type of a given data series+setSeriesType :: Int -> SeriesType -> Plot ()+setSeriesType i t = withData $ D.setSeriesType t i+ +-- | change the plot type of all data series+setAllSeriesTypes :: SeriesType -> Plot ()+setAllSeriesTypes t = withData $ D.setAllSeriesTypes t++-- | format the plot elements of a given series+withSeriesFormat :: D.PlotFormats m => Int -> m () -> Plot ()+withSeriesFormat i f = withData $ D.withSeriesFormat i f++{- |+ format the plot elements of all series++ the operation to modify the formats is passed the series index.+ This allows, for example, colours to be selected from a list+ that gets indexed by the argument+ +> setColour = withAllSeriesFormats (\i -> do+> setLineColour $ [black,blue,red,green,yellow] !! i+> setLineWidth 1.0)+-}+withAllSeriesFormats :: D.PlotFormats m => (Int -> m ()) -> Plot ()+withAllSeriesFormats f = withData $ D.withAllSeriesFormats f++-----------------------------------------------------------------------------++findMinMax :: Abscissae -> Ordinates -> (Double,Double)+findMinMax AbsFunction (OrdFunction _ f _) = let v = mapVector f (linspace 100 (-1,1))+ in (minElement v,maxElement v)+findMinMax (AbsPoints x) (OrdFunction _ f _) = let v = mapVector f x+ in (minElement v,maxElement v)+ -- what if errors go beyond plot?+findMinMax _ (OrdPoints _ y _) = let o = getOrdData y+ in (minElement o,maxElement o)++abscMinMax :: Abscissae -> (Double,Double)+abscMinMax AbsFunction = defaultXAxisSideLowerRange+abscMinMax (AbsPoints x) = (minElement x,maxElement x)+++ordDim :: Ordinates -> Int+ordDim (OrdFunction _ _ _) = 1+ordDim (OrdPoints _ o _) = dim $ getOrdData o+++calculateRanges :: DataSeries -> ((Double,Double),(Double,Double))+calculateRanges (DS_Y ys) = let xmax = maximum $ map (\(DecSeries o _) -> fromIntegral $ ordDim o) $ A.elems ys+ ym = unzip $ map (\(DecSeries o _) -> findMinMax AbsFunction o) $ A.elems ys+ ymm = (minimum $ fst ym,maximum $ snd ym)+ in ((0,xmax),ymm)+calculateRanges (DS_1toN x ys) = let ym = unzip $ map (\(DecSeries o _) -> findMinMax x o) $ A.elems ys+ ymm = (minimum $ fst ym,maximum $ snd ym)+ xmm = abscMinMax x+ in (xmm,ymm)+calculateRanges (DS_1to1 ys) = let (xm',ym') = unzip $ A.elems ys+ ym = unzip $ map (\(x,(DecSeries o _)) -> findMinMax x o) (zip xm' ym')+ ymm = (minimum $ fst ym,maximum $ snd ym)+ xm = unzip $ map abscMinMax xm'+ xmm = (minimum $ fst xm,maximum $ snd xm) + in (xmm,ymm)+calculateRanges (DS_Surf m) = ((0,fromIntegral $ rows m),(fromIntegral $ cols m,0))++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs view
@@ -0,0 +1,82 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Plot.Axis+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Axis+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Plot.Axis (+ Axis+ , AxisType(..),AxisSide(..),AxisPosn(..)+ , Tick(..), TickValues, GridLines+ , setTicks+ , setGridlines+ , setTickLabelFormat+ , withAxisLabel+ , withAxisLine+ ) where++-----------------------------------------------------------------------------++import Control.Monad.State+import Control.Monad.Reader++import Graphics.Rendering.Plot.Types++-----------------------------------------------------------------------------++changeLineType :: LineType -> AxisData -> AxisData+changeLineType lt ax = ax { _line_type = lt }++changeMinorTicks :: (Ticks -> Ticks) -> AxisData -> AxisData+changeMinorTicks t ax = ax { _minor_ticks = t (_minor_ticks ax) }++changeMajorTicks :: (Ticks -> Ticks) -> AxisData -> AxisData+changeMajorTicks t ax = ax { _major_ticks = t (_major_ticks ax) }++changeTickFormat :: TickFormat -> AxisData -> AxisData+changeTickFormat tf ax = ax { _tick_format = tf }++changeLabel :: (TextEntry -> TextEntry) -> AxisData -> AxisData+changeLabel f ax = ax { _label = f (_label ax) }++-----------------------------------------------------------------------------++-- | format the axis line+withAxisLine :: Line () -> Axis ()+withAxisLine m = do+ l <- gets _line_type+ lo <- asks _lineoptions+ let lt = execLine m lo l+ modify $ \s -> s { _line_type = lt }++-- | format the axis ticks+setTicks :: Tick -> TickValues -> Axis ()+setTicks Minor ts = modify $ \s -> changeMinorTicks (setTickValues ts) s+setTicks Major ts = modify $ \s -> changeMajorTicks (setTickValues ts) s++-- | should gridlines be displayed?+setGridlines :: Tick -> GridLines -> Axis ()+setGridlines Minor gl = modify $ \s -> changeMinorTicks (setTickGridlines gl) s+setGridlines Major gl = modify $ \s -> changeMajorTicks (setTickGridlines gl) s++-- | printf format that takes one argument, the tick value+setTickLabelFormat :: String -> Axis ()+setTickLabelFormat tf = modify $ \s -> changeTickFormat tf s++-- | operate on the axis label+withAxisLabel :: Text () -> Axis ()+withAxisLabel m = do+ ax <- get+ to <- asks _textoptions+ put $ ax { _label = execText m to (_label ax) } ++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs view
@@ -0,0 +1,714 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Plot.Data+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- 'Data' operations+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Plot.Data (+ Data+ -- * Series data+ , FormattedSeries()+ , line, point, linepoint+ , impulse, step+ , area+ , bar+ , hist+ , setDataSeries+ -- * Plot type+ , setSeriesType+ , setAllSeriesTypes+ -- * Formatting+ , PlotFormats(..)+ , withSeriesFormat+ , withAllSeriesFormats+ -- * Internal+ , Abscissa(), Ordinate(), Dataset()+ ) where++-----------------------------------------------------------------------------++--import Data.Packed.Vector++import Data.Maybe++import qualified Data.Array.IArray as A++import Control.Monad.State+import Control.Monad.Reader+import Control.Monad.Supply++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Figure.Line+import Graphics.Rendering.Plot.Figure.Point+import Graphics.Rendering.Plot.Figure.Bar++-----------------------------------------------------------------------------++dataSeriesNum :: DataSeries -> Int+dataSeriesNum (DS_Y a) = A.rangeSize $ A.bounds $ a+dataSeriesNum (DS_1toN _ a) = A.rangeSize $ A.bounds $ a+dataSeriesNum (DS_1to1 a) = A.rangeSize $ A.bounds $ a+dataSeriesNum (DS_Surf _) = 1++-----------------------------------------------------------------------------++class SeriesTypes a where+ setSeriesType'' :: SeriesType -> a -> Data a++instance SeriesTypes Decoration where+ setSeriesType'' Line d@(DecLine _) = return d+ setSeriesType'' Line (DecPoint pt) = do+ let c = getPointColour pt+ lt <- toLine c+ return $ DecLine lt+ setSeriesType'' Line (DecLinPt lt _) = return $ DecLine lt+ setSeriesType'' Line (DecImpulse lt) = return $ DecLine lt+ setSeriesType'' Line (DecStep lt) = return $ DecLine lt+ setSeriesType'' Line (DecArea lt) = return $ DecLine lt+ setSeriesType'' Line (DecBar bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecLine lt+ setSeriesType'' Line (DecHist bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecLine lt+ setSeriesType'' Point (DecLine lt) = do+ let c = fromJust $ getLineColour lt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecPoint pt+ setSeriesType'' Point d@(DecPoint _) = return d+ setSeriesType'' Point (DecLinPt _ pt) = return $ DecPoint pt+ setSeriesType'' Point (DecImpulse lt) = do+ let c = fromJust $ getLineColour lt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecPoint pt+ setSeriesType'' Point (DecStep lt) = do+ let c = fromJust $ getLineColour lt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecPoint pt+ setSeriesType'' Point (DecArea lt) = do+ let c = fromJust $ getLineColour lt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecPoint pt+ setSeriesType'' Point (DecBar bt) = do+ let c = getBarColour bt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecPoint pt+ setSeriesType'' Point (DecHist bt) = do+ let c = getBarColour bt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecPoint pt+ setSeriesType'' LinePoint (DecLine lt) = do+ let c = fromJust $ getLineColour lt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecLinPt lt pt+ setSeriesType'' LinePoint (DecPoint pt) = do+ let c = getPointColour pt+ lt <- toLine (c :: Color)+ return $ DecLinPt lt pt+ setSeriesType'' LinePoint d@(DecLinPt _ _) = return d+ setSeriesType'' LinePoint (DecImpulse lt) = do+ let c = fromJust $ getLineColour lt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecLinPt lt pt+ setSeriesType'' LinePoint (DecStep lt) = do+ let c = fromJust $ getLineColour lt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecLinPt lt pt+ setSeriesType'' LinePoint (DecArea lt) = do+ let c = fromJust $ getLineColour lt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecLinPt lt pt+ setSeriesType'' LinePoint (DecBar bt) = do+ let c = getBarColour bt+ lt <- toLine c+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecLinPt lt pt+ setSeriesType'' LinePoint (DecHist bt) = do+ let c = getBarColour bt+ lt <- toLine c+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecLinPt lt pt+ setSeriesType'' Impulse (DecLine lt) = return $ DecImpulse lt+ setSeriesType'' Impulse (DecPoint pt) = do+ let c = getPointColour pt+ lt <- toLine c+ return $ DecImpulse lt+ setSeriesType'' Impulse (DecLinPt lt _) = return $ DecImpulse lt+ setSeriesType'' Impulse d@(DecImpulse _) = return d+ setSeriesType'' Impulse (DecStep lt) = return $ DecImpulse lt+ setSeriesType'' Impulse (DecArea lt) = return $ DecImpulse lt+ setSeriesType'' Impulse (DecBar bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecImpulse lt+ setSeriesType'' Impulse (DecHist bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecImpulse lt+ setSeriesType'' Step (DecLine lt) = return $ DecStep lt+ setSeriesType'' Step (DecPoint pt) = do+ let c = getPointColour pt+ lt <- toLine c+ return $ DecStep lt+ setSeriesType'' Step (DecLinPt lt _) = return $ DecStep lt+ setSeriesType'' Step (DecImpulse lt) = return $ DecStep lt + setSeriesType'' Step d@(DecStep _) = return d+ setSeriesType'' Step (DecArea lt) = return $ DecStep lt + setSeriesType'' Step (DecBar bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecStep lt+ setSeriesType'' Step (DecHist bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecStep lt+ setSeriesType'' Area (DecLine lt) = return $ DecArea lt+ setSeriesType'' Area (DecPoint pt) = do+ let c = getPointColour pt+ lt <- toLine c+ return $ DecArea lt+ setSeriesType'' Area (DecLinPt lt _) = return $ DecArea lt+ setSeriesType'' Area (DecImpulse lt) = return $ DecArea lt + setSeriesType'' Area (DecStep lt) = return $ DecArea lt + setSeriesType'' Area d@(DecArea _) = return d+ setSeriesType'' Area (DecBar bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecArea lt+ setSeriesType'' Area (DecHist bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecArea lt+ setSeriesType'' Bar (DecLine lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecBar bt+ setSeriesType'' Bar (DecPoint pt) = do+ let c = getPointColour pt+ bt <- toBar c+ return $ DecBar bt+ setSeriesType'' Bar (DecLinPt lt _) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecBar bt+ setSeriesType'' Bar (DecImpulse lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecBar bt+ setSeriesType'' Bar (DecStep lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecBar bt+ setSeriesType'' Bar (DecArea lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecBar bt+ setSeriesType'' Bar d@(DecBar _) = return d+ setSeriesType'' Bar (DecHist bt) = return $ DecBar bt+ setSeriesType'' Hist (DecLine lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecHist bt+ setSeriesType'' Hist (DecPoint pt) = do+ let c = getPointColour pt+ bt <- toBar c+ return $ DecHist bt+ setSeriesType'' Hist (DecLinPt lt _) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecHist bt+ setSeriesType'' Hist (DecImpulse lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecHist bt+ setSeriesType'' Hist (DecStep lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecHist bt+ setSeriesType'' Hist (DecArea lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecHist bt+ setSeriesType'' Hist (DecBar bt) = return $ DecHist bt+ setSeriesType'' Hist d@(DecHist _) = return d++instance SeriesTypes DecoratedSeries where+ setSeriesType'' t (DecSeries o d) = do+ d' <- setSeriesType'' t d+ return $ DecSeries o d'++setSeriesType' :: Int -> SeriesType -> DataSeries -> Data DataSeries+setSeriesType' i t (DS_Y a) = do+ s' <- setSeriesType'' t $ a A.! i+ return $ DS_Y $ a A.// [(i,s')] +setSeriesType' i t (DS_1toN x a) = do+ s' <- setSeriesType'' t $ a A.! i+ return $ DS_1toN x $ a A.// [(i,s')] +setSeriesType' i t (DS_1to1 a) = do+ let (x,s) = a A.! i+ s' <- setSeriesType'' t s+ return $ DS_1to1 $ a A.// [(i,(x,s'))] +setSeriesType' _ _ d@(DS_Surf _) = return d+ +-- | set the series type of a given data series+setSeriesType :: SeriesType -> Int -> Data ()+setSeriesType t i = do+ ds <- get+ ds' <- setSeriesType' i t ds+ put ds'+ +-- | set the series type of all data series+setAllSeriesTypes :: SeriesType -> Data ()+setAllSeriesTypes t = do+ ds <- get+ let ln = dataSeriesNum ds+ mapM_ (setSeriesType t) [1..ln]++-----------------------------------------------------------------------------++class PlotFormats m where+ modifyFormat :: m () -> DecoratedSeries -> Data DecoratedSeries++instance PlotFormats Line where+ modifyFormat l (DecSeries o (DecLine lt)) = do+ lo <- asks _lineoptions+ let lt' = execLine l lo lt+ return $ DecSeries o (DecLine lt')+ modifyFormat _ d@(DecSeries _ (DecPoint _)) = return d+ modifyFormat l (DecSeries o (DecLinPt lt pt)) = do+ lo <- asks _lineoptions+ let lt' = execLine l lo lt+ return $ DecSeries o (DecLinPt lt' pt)+ modifyFormat l (DecSeries o (DecImpulse lt)) = do+ lo <- asks _lineoptions+ let lt' = execLine l lo lt+ return $ DecSeries o (DecImpulse lt')+ modifyFormat l (DecSeries o (DecStep lt)) = do+ lo <- asks _lineoptions+ let lt' = execLine l lo lt+ return $ DecSeries o (DecStep lt')+ modifyFormat l (DecSeries o (DecArea lt)) = do+ lo <- asks _lineoptions+ let lt' = execLine l lo lt+ return $ DecSeries o (DecArea lt')+ modifyFormat _ d@(DecSeries _ (DecBar _)) = return d+ modifyFormat _ d@(DecSeries _ (DecHist _)) = return d++instance PlotFormats Point where+ modifyFormat _ d@(DecSeries _ (DecLine _)) = return d+ modifyFormat _ d@(DecSeries _ (DecImpulse _)) = return d+ modifyFormat _ d@(DecSeries _ (DecStep _)) = return d+ modifyFormat _ d@(DecSeries _ (DecArea _)) = return d+ modifyFormat _ d@(DecSeries _ (DecBar _)) = return d+ modifyFormat _ d@(DecSeries _ (DecHist _)) = return d+ modifyFormat p (DecSeries o (DecPoint pt)) = do+ po <- asks _pointoptions+ let pt' = execPoint p po pt+ return $ DecSeries o (DecPoint pt')+ modifyFormat p (DecSeries o (DecLinPt lt pt)) = do+ po <- asks _pointoptions+ let pt' = execPoint p po pt+ return $ DecSeries o (DecLinPt lt pt')++instance PlotFormats Bar where+ modifyFormat _ d@(DecSeries _ (DecLine _)) = return d+ modifyFormat _ d@(DecSeries _ (DecImpulse _)) = return d+ modifyFormat _ d@(DecSeries _ (DecStep _)) = return d+ modifyFormat _ d@(DecSeries _ (DecArea _)) = return d+ modifyFormat _ d@(DecSeries _ (DecPoint _)) = return d+ modifyFormat _ d@(DecSeries _ (DecLinPt _ _)) = return d+ modifyFormat b (DecSeries o (DecBar bt)) = do + bo <- asks _baroptions+ let bt' = execBar b bo bt+ return $ DecSeries o (DecBar bt')+ modifyFormat b (DecSeries o (DecHist bt)) = do + bo <- asks _baroptions+ let bt' = execBar b bo bt+ return $ DecSeries o (DecHist bt')++-- | format the plot elements of a given series+withSeriesFormat :: PlotFormats m => Int -> m () -> Data ()+withSeriesFormat i f = do+ ds <- get+ ds' <- case ds of+ (DS_Y a) -> do+ let d = a A.! i+ d' <- modifyFormat f d+ return $ DS_Y $ a A.// [(i,d')]+ (DS_1toN x a) -> do+ let d = a A.! i+ d' <- modifyFormat f d+ return $ DS_1toN x $ a A.// [(i,d')]+ (DS_1to1 a) -> do+ let (x,d) = a A.! i+ d' <- modifyFormat f d+ return $ DS_1to1 $ a A.// [(i,(x,d'))]+ d@(DS_Surf _) -> return d+ put ds'++-- | format the plot elements of all series+-- | the operation to modify the formats is passed the series index+-- | this allows, for example, colours to be selected from a list+-- | that gets indexed by the argument+-- | @setColour i = setLineColour $ [black,blue,red,green,yellow] !! i@+withAllSeriesFormats :: PlotFormats m => (Int -> m ()) -> Data ()+withAllSeriesFormats f = do+ ds <- get+ let ln = dataSeriesNum ds+ mapM_ (\i -> withSeriesFormat i (f i)) [1..ln]+ +-----------------------------------------------------------------------------++class Abscissa a where+ toAbscissa :: a -> Abscissae++toAbscissae :: Abscissa a => [a] -> [Abscissae]+toAbscissae = map toAbscissa++instance Abscissa Series where toAbscissa s = AbsPoints s++class Ordinate a where+ toOrdinate :: a -> Ordinates++toOrdinates :: Ordinate a => [a] -> [Ordinates]+toOrdinates = map toOrdinate++instance Ordinate Function where toOrdinate f = OrdFunction Lower f Nothing+instance Ordinate Series where toOrdinate s = OrdPoints Lower (Plain s) Nothing+instance Ordinate (Series,ErrorSeries) where toOrdinate (s,e) = OrdPoints Lower (Error s (e,e)) Nothing+instance Ordinate (Series,(ErrorSeries,ErrorSeries)) where toOrdinate (s,(l,u)) = OrdPoints Lower (Error s (l,u)) Nothing++instance Ordinate (Function,AxisSide) where toOrdinate (f,ax) = OrdFunction ax f Nothing+instance Ordinate (Series,AxisSide) where toOrdinate (s,ax) = OrdPoints ax (Plain s) Nothing+instance Ordinate (Series,ErrorSeries,AxisSide) where toOrdinate (s,e,ax) = OrdPoints ax (Error s (e,e)) Nothing+instance Ordinate (Series,(ErrorSeries,ErrorSeries),AxisSide) where toOrdinate (s,(l,u),ax) = OrdPoints ax (Error s (l,u)) Nothing++instance Ordinate (Function,SeriesLabel) where toOrdinate (f,la) = OrdFunction Lower f (Just la)+instance Ordinate (Series,SeriesLabel) where toOrdinate (s,la) = OrdPoints Lower (Plain s) (Just la)+instance Ordinate (Series,ErrorSeries,SeriesLabel) where toOrdinate (s,e,la) = OrdPoints Lower (Error s (e,e)) (Just la)+instance Ordinate (Series,(ErrorSeries,ErrorSeries),SeriesLabel) where toOrdinate (s,(l,u),la) = OrdPoints Lower (Error s (l,u)) (Just la)++instance Ordinate (Function,AxisSide,SeriesLabel) where toOrdinate (f,ax,la) = OrdFunction ax f (Just la)+instance Ordinate (Series,AxisSide,SeriesLabel) where toOrdinate (s,ax,la) = OrdPoints ax (Plain s) (Just la)+instance Ordinate (Series,ErrorSeries,AxisSide,SeriesLabel) where toOrdinate (s,e,ax,la) = OrdPoints ax (Error s (e,e)) (Just la)+instance Ordinate (Series,(ErrorSeries,ErrorSeries),AxisSide,SeriesLabel) where toOrdinate (s,(l,u),ax,la) = OrdPoints ax (Error s (l,u)) (Just la)++class Decorations a where+ toDecoration :: a -> Decoration++toDecorations :: Decorations a => [a] -> [Decoration]+toDecorations = map toDecoration++instance Decorations LineType where toDecoration l = DecLine l+instance Decorations PointType where toDecoration p = DecPoint p+instance Decorations (LineType,PointType) where toDecoration (l,p) = DecLinPt l p+instance Decorations (PointType,LineType) where toDecoration (p,l) = DecLinPt l p+instance Decorations BarType where toDecoration b = DecBar b+instance Decorations Decoration where toDecoration = id++format :: (Ordinate a, Decorations b) => a -> b -> DecoratedSeries+format o f = DecSeries (toOrdinate o) (toDecoration f)++line :: (Ordinate a, LineFormat b) => a -> b -> FormattedSeries+line o f = do+ f' <- toLine f+ return $ format o f'++point :: (Ordinate a, PointFormat b) => a -> b -> FormattedSeries+point o f = do+ f' <- toPoint f+ return $ format o f'++linepoint :: (Ordinate a, LineFormat b, PointFormat c) => a -> b -> c -> FormattedSeries+linepoint o l p = do+ l' <- toLine l+ p' <- toPoint p+ return $ format o (l',p')++impulse :: (Ordinate a, LineFormat b) => a -> b -> FormattedSeries+impulse o f = do+ f' <- toLine f+ setSeriesType'' Impulse (format o f')++step :: (Ordinate a, LineFormat b) => a -> b -> FormattedSeries+step o f = do+ f' <- toLine f+ setSeriesType'' Step (format o f')+ +area :: (Ordinate a, LineFormat b) => a -> b -> FormattedSeries+area o f = do+ f' <- toLine f+ setSeriesType'' Area (format o f')++bar :: (Ordinate a, BarFormat b) => a -> b -> FormattedSeries+bar o f = do+ f' <- toBar f+ return $ format o f'++hist :: (Ordinate a, BarFormat b) => a -> b -> FormattedSeries+hist o f = do+ f' <- toBar f+ setSeriesType'' Hist (format o f')++-----------------------------------------------------------------------------++getType :: SeriesType -> Data Decoration+getType Line = do+ c <- supply+ lt <- toLine (c :: Color)+ return $ toDecoration lt+getType Point = do+ g <- supply+ pt <- toPoint (g :: Glyph) + return $ toDecoration pt+getType LinePoint = do+ c <- supply+ g <- supply+ lt <- toLine (c :: Color)+ pt <- toPoint (g :: Glyph)+ return $ toDecoration (lt,pt)+getType Impulse = do+ c <- supply+ lt <- toLine (c :: Color)+ setSeriesType'' Impulse $ toDecoration lt+getType Step = do+ c <- supply+ lt <- toLine (c :: Color)+ setSeriesType'' Impulse $ toDecoration lt+getType Area = do+ c <- supply+ lt <- toLine (c :: Color)+ setSeriesType'' Area $ toDecoration lt+getType Bar = do+ c <- supply+ bt <- toBar (c :: Color)+ return $ toDecoration bt+getType Hist = do+ c <- supply+ bt <- toBar (c :: Color)+ setSeriesType'' Hist $ toDecoration bt++getNTypes :: Int -> SeriesType -> Data [Decoration]+getNTypes n st = mapM getType (replicate n st)++-----------------------------------------------------------------------------++class Dataset a where+ toDataSeries :: a -> Data DataSeries++instance Dataset Surface where+ toDataSeries m = return $ DS_Surf m+ ++instance (Ordinate a) => Dataset (SeriesType,[a]) where + toDataSeries (Line,os) = do+ let ln = length os+ cs <- supplyN ln+ ls <- mapM toLine (cs :: [Color])+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ls+ toDataSeries (Point,os) = do+ let ln = length os+ cs <- supplyN ln+ gs <- supplyN ln+ ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color]))+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ps+ toDataSeries (LinePoint,os) = do+ let ln = length os+ cs <- supplyN ln+ gs <- supplyN ln+ ls <- mapM toLine cs+ ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color]))+ let ds = toDecorations (zip ls ps)+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds+ toDataSeries (Impulse,os) = do+ let ln = length os+ cs <- supplyN ln+ ls <- mapM toLine (cs :: [Color])+ ds <- mapM (setSeriesType'' Impulse) $ toDecorations ls+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds+ toDataSeries (Step,os) = do+ let ln = length os+ cs <- supplyN ln+ ls <- mapM toLine (cs :: [Color])+ ds <- mapM (setSeriesType'' Step) $ toDecorations ls+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds+ toDataSeries (Area,os) = do+ let ln = length os+ cs <- supplyN ln+ ls <- mapM toLine (cs :: [Color])+ ds <- mapM (setSeriesType'' Area) $ toDecorations ls+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds+ toDataSeries (Bar,os) = do+ let ln = length os+ cs <- supplyN ln+ bs <- mapM toBar (cs :: [Color])+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os bs+ toDataSeries (Hist,os) = do+ let ln = length os+ cs <- supplyN ln+ bs <- mapM toBar (cs :: [Color])+ ds <- mapM (setSeriesType'' Hist) $ toDecorations bs+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds++instance (Abscissa a, Ordinate b) => Dataset (SeriesType,a,[b]) where+ toDataSeries (Line,t,os) = do+ let ln = length os+ cs <- supplyN ln+ ls <- mapM toLine (cs :: [Color])+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ls+ toDataSeries (Point,t,os) = do+ let ln = length os+ cs <- supplyN ln+ gs <- supplyN ln+ ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color]))+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ps+ toDataSeries (LinePoint,t,os) = do+ let ln = length os+ cs <- supplyN ln+ gs <- supplyN ln+ ls <- mapM toLine cs+ ps <- mapM toPoint (zip (gs :: [Glyph]) (cs :: [Color]))+ let ds = toDecorations (zip ls ps)+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ds+ toDataSeries (Impulse,t,os) = do+ let ln = length os+ cs <- supplyN ln+ ls <- mapM toLine (cs :: [Color])+ ds <- mapM (setSeriesType'' Impulse) $ toDecorations ls+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ds+ toDataSeries (Step,t,os) = do+ let ln = length os+ cs <- supplyN ln+ ls <- mapM toLine (cs :: [Color])+ ds <- mapM (setSeriesType'' Step) $ toDecorations ls+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ds+ toDataSeries (Area,t,os) = do+ let ln = length os+ cs <- supplyN ln+ ls <- mapM toLine (cs :: [Color])+ ds <- mapM (setSeriesType'' Area) $ toDecorations ls+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ds+ toDataSeries (Bar,t,os) = do+ let ln = length os+ cs <- supplyN ln+ bs <- mapM toBar (cs :: [Color])+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os bs+ toDataSeries (Hist,t,os) = do+ let ln = length os+ cs <- supplyN ln+ bs <- mapM toBar (cs :: [Color])+ ds <- mapM (setSeriesType'' Hist) $ toDecorations bs+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ds++instance (Abscissa a, Ordinate b) => Dataset [(SeriesType,a,b)] where+ toDataSeries prs = do+ let ln = length prs+ (ss,xs,ys) = unzip3 prs+ ds <- mapM toDataSeries' $ zip ss ys+ return $ DS_1to1 $ A.listArray (1,ln) $ zip (toAbscissae xs) ds+++toDataSeries' :: Ordinate b => (SeriesType,b) -> Data DecoratedSeries+toDataSeries' (Line,o) = do+ c <- supply + l <- toLine (c :: Color)+ return $ format o l+toDataSeries' (Point,o) = do+ c <- supply + g <- supply+ p <- toPoint ((g :: Glyph),(c :: Color))+ return $ format o p+toDataSeries' (LinePoint,o) = do+ c <- supply + g <- supply+ l <- toLine (c :: Color)+ p <- toPoint ((g :: Glyph),(c :: Color))+ let d = toDecoration (l,p)+ return $ format o d+toDataSeries' (Impulse,o) = do+ c <- supply + l <- toLine (c :: Color)+ d <- setSeriesType'' Impulse $ toDecoration l+ return $ format o d+toDataSeries' (Step,o) = do+ c <- supply + l <- toLine (c :: Color)+ d <- setSeriesType'' Step $ toDecoration l+ return $ format o d+toDataSeries' (Area,o) = do+ c <- supply + l <- toLine (c :: Color)+ d <- setSeriesType'' Area $ toDecoration l+ return $ format o d+toDataSeries' (Bar,o) = do+ c <- supply + b <- toBar (c :: Color)+ return $ format o b+toDataSeries' (Hist,o) = do+ c <- supply + b <- toBar (c :: Color)+ d <- setSeriesType'' Hist $ toDecoration b+ return $ format o d++instance Dataset [FormattedSeries] where + toDataSeries ds = do+ let ln = length ds+ ds' <- sequence ds+ return $ DS_Y $ A.listArray (1,ln) ds'++instance (Abscissa a) => Dataset (a,[FormattedSeries]) where+ toDataSeries (t,prs) = do+ let ln = length prs+ prs' <- sequence prs+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) prs'++instance (Abscissa a) => Dataset [(a,FormattedSeries)] where+ toDataSeries prs = do+ let ln = length prs+ (xs,ys) = unzip prs+ ys' <- sequence ys+ return $ DS_1to1 $ A.listArray (1,ln) (zip (toAbscissae xs) ys')+++-- | set the data set+setDataSeries :: Dataset a => a -> Data ()+setDataSeries d = do+ ds <- toDataSeries d+ put ds++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Figure/Plot/Legend.hs view
@@ -0,0 +1,58 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Plot.Legend+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Axis+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Plot.Legend (+ Legend+ , LegendBorder+ , LegendLocation(..), LegendOrientation(..)+ , clearLegend+ , setLegend+ , withLegendFormat+ ) where++-----------------------------------------------------------------------------++import Control.Monad.State+import Control.Monad.Reader++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults++import Graphics.Rendering.Plot.Figure.Text++-----------------------------------------------------------------------------++-- | clear the legend+clearLegend :: Legend ()+clearLegend = put Nothing++-- | set the legend location (required for there to be a legend)+setLegend :: LegendBorder -> LegendLocation -> LegendOrientation -> Legend ()+setLegend b l o = do+ to <- ask+ put $ Just $ Legend b l o (scaleFontSize legendLabelScale to) ++-- | operate on the axis label+withLegendFormat :: Text () -> Legend ()+withLegendFormat m = do+ l <- get+ let legend = case l of+ Nothing -> defaultLegend+ Just l' -> l'+ to' <- ask+ let (FontText to _) = execText m to' (FontText to' "")+ put $ Just $ legend { _leg_fmt = to } ++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Figure/Point.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Point+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- 'Point' operations+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Point (+ Point, PointFormat(..)+ , PointSize+-- , clearPointFormat+ , setGlyph+ , setPointSize+ , setPointColour+ , getPointColour+ ) where++-----------------------------------------------------------------------------++--import Data.Word+import Data.Colour+--import Data.Colour.SRGB+--import Data.Colour.Names++--import qualified Graphics.Rendering.Cairo as C+--import qualified Graphics.Rendering.Pango as P++import Control.Monad.State+import Control.Monad.Reader+import Control.Monad.Supply++import Graphics.Rendering.Plot.Types++-----------------------------------------------------------------------------++changePointSize :: PointSize -> PointOptions -> PointOptions+changePointSize sz (PointOptions _ c) = PointOptions sz c++changePointColour :: Color -> PointOptions -> PointOptions+changePointColour c (PointOptions sz _) = PointOptions sz c++getPointColour :: PointType -> Color+getPointColour (FullPoint (PointOptions _ c) _) = c++changePointGlyph :: Glyph -> PointType -> PointType+--changePointGlyph gt s (BarePoint _) = BarePoint (Glyph gt s)+changePointGlyph g (FullPoint po _) = FullPoint po g++-----------------------------------------------------------------------------+{-+-- | clear the formatting of a point+clearPointFormat :: Point ()+clearPointFormat = do+ pt <- get+ case pt of+ g@(BarePoint _) -> put g+ (FullPoint _ g) -> put $ BarePoint g+-}++changePointOptions :: (PointOptions -> PointOptions) -> PointType -> Point ()+--changePointOptions o (BarePoint g) = do+-- po <- ask+-- put $ FullPoint (o po) g+changePointOptions o (FullPoint po g) = put $ FullPoint (o po) g++-- | change the glyph of a point+setGlyph :: Glyph -> Point ()+setGlyph g = modify $ \s -> changePointGlyph g s++-- | change the size of a point+setPointSize :: PointSize -> Point ()+setPointSize sz = get >>= changePointOptions (changePointSize sz)++-- | change the colour of a point+setPointColour :: Color -> Point ()+setPointColour c = get >>= changePointOptions (changePointColour c)++-----------------------------------------------------------------------------++class PointFormat a where+ toPoint :: (MonadReader Options m, MonadSupply SupplyData m) => a -> m PointType+ +instance PointFormat Glyph where toPoint g = do+ po <- asks _pointoptions+ c <- supply+ return $ FullPoint (changePointColour c po) g+--instance PointFormat GlyphType where toPoint g = return $ BarePoint g+instance Real a => PointFormat (Colour a) where toPoint c = do+ po <- asks _pointoptions+ g <- supply+ return $ FullPoint (changePointColour (colourConvert c) po) g+instance PointFormat (Glyph,PointSize) where toPoint (g,s) = do+ po <- asks _pointoptions+ c <- supply+ return $ FullPoint (changePointSize s $ changePointColour c po) g+instance Real a => PointFormat (Glyph,Colour a) where toPoint (g,c) = do+ po <- asks _pointoptions+ return $ FullPoint (changePointColour (colourConvert c) po) g+instance Real a => PointFormat (Glyph,PointSize,Colour a) where toPoint (g,s,c) = return $ FullPoint (PointOptions s (colourConvert c)) g++-----------------------------------------------------------------------------++{- TODO++ fix Glyph/GlyphType differences+ NoPoint option?+-}++
+ lib/Graphics/Rendering/Plot/Figure/Simple.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE UnicodeSyntax #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- One line 'Figure' creation+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Simple (+ -- * Plotting+ plot+ , loglog, semilog+ , parametric+ -- * Formatting+ , title+ , subtitle+ -- | The following functions can+ -- be applied to a figure or a plot.+ -- When applied in 'Figure' context+ -- a single plot is assumed+ , Simple()+ , grid+ , xrange, yrange+ , xautorange, yautorange+ , xautorangeLog, yautorangeLog+ , xlabel, ylabel+ ) where++-----------------------------------------------------------------------------++import Numeric.Container++import Graphics.Rendering.Plot.Figure++-----------------------------------------------------------------------------++-- | create a figure with a single linear plot +-- with lower X and Y axes whose ranges are set from the data+plot :: Dataset d => d -> Figure ()+plot ds = do+ setPlots 1 1+ withPlot (1,1) $ do+ setDataset ds+ addAxis XAxis (Side Lower) $ return ()+ addAxis YAxis (Side Lower) $ return ()+ setRangeFromData XAxis Lower Linear+ setRangeFromData YAxis Lower Linear++-- | create a figure with a single linear-log plot +-- with lower X and Y axes whose ranges are set from the data+semilog :: Dataset d => d -> Figure ()+semilog ds = do+ setPlots 1 1+ withPlot (1,1) $ do+ setDataset ds+ addAxis XAxis (Side Lower) $ return ()+ addAxis YAxis (Side Lower) $ return ()+ setRangeFromData XAxis Lower Linear+ setRangeFromData YAxis Lower Log++-- | create a figure with a single log-log plot +-- with lower X and Y axes whose ranges are set from the data+loglog :: Dataset d => d -> Figure ()+loglog ds = do+ setPlots 1 1+ withPlot (1,1) $ do+ setDataset ds+ addAxis XAxis (Side Lower) $ return ()+ addAxis YAxis (Side Lower) $ return ()+ setRangeFromData XAxis Lower Log+ setRangeFromData YAxis Lower Log++-- | create a figure with a single parametric plot over n points+-- with lower X and Y axes whose ranges are set from the data+parametric :: (Double -> Double,Double -> Double) -> (Double,Double) -> Int -> Figure ()+parametric (fx,fy) (l,h) n = do+ setPlots 1 1+ withPlot (1,1) $ do+ let t = linspace n (l,h)+ setDataset (Line,mapVector fx t,[mapVector fy t])+ addAxis XAxis (Side Lower) $ return ()+ addAxis YAxis (Side Lower) $ return ()+ setRangeFromData XAxis Lower Linear+ setRangeFromData YAxis Lower Linear++-----------------------------------------------------------------------------++-- | set the title+title :: String -> Figure ()+title s = withTitle $ setText s++-- | set the subtitle+subtitle :: String -> Figure ()+subtitle s = withSubTitle $ setText s++-----------------------------------------------------------------------------++class Simple m where+ simple :: Plot () -> m ()++instance Simple Plot where+ simple m = m++instance Simple Figure where+ simple m = withPlot (1,1) m++-- | set the gridlines+grid :: Simple m => Bool -> m ()+grid b = simple $ do+ withAxis XAxis (Side Lower) $ setGridlines Major b+ withAxis YAxis (Side Lower) $ setGridlines Major b++-- | set the x range+xrange :: Simple m => Scale -> Double -> Double → m ()+xrange s l h = simple $ setRange XAxis Lower s l h ++-- | set the y range+yrange :: Simple m => Scale -> Double -> Double → m ()+yrange s l h = simple $ setRange YAxis Lower s l h++-- | set the x range from data+xautorange :: Simple m => m ()+xautorange = simple $ setRangeFromData XAxis Lower Linear++-- | set the y range from data+yautorange :: Simple m => m ()+yautorange = simple $ setRangeFromData YAxis Lower Linear++-- | set the x range from data+xautorangeLog :: Simple m => m ()+xautorangeLog = simple $ setRangeFromData XAxis Lower Log++-- | set the y range from data+yautorangeLog :: Simple m => m ()+yautorangeLog = simple $ setRangeFromData YAxis Lower Log++-- | set the x label+xlabel :: Simple m => String -> m ()+xlabel s = simple $ withAxis XAxis (Side Lower) $ withAxisLabel $ setText s++-- | set the y label+ylabel :: Simple m => String -> m ()+ylabel s = simple $ withAxis YAxis (Side Lower) $ withAxisLabel $ setText s++-----------------------------------------------------------------------------
+ lib/Graphics/Rendering/Plot/Figure/Text.hs view
@@ -0,0 +1,181 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Text+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- 'Text' operations+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Text (+ Text+ , FontFamily,FontSize,Color+ -- | A text element must exist for formatting to work+ , clearText+ , clearTextFormat+ , setText+ , setFontFamily+ , setFontStyle+ , setFontVariant+ , setFontWeight+ , setFontStretch+ , setFontSize+ , setFontColour+ --+ , changeFontSize+ , changeFontColour+ --+ , scaleFontSize+ ) where++-----------------------------------------------------------------------------++import Control.Monad.State+import Control.Monad.Reader++import qualified Graphics.Rendering.Pango as P++import Graphics.Rendering.Plot.Types++-----------------------------------------------------------------------------++changeFontFamilyFont :: FontFamily -> FontOptions -> FontOptions+changeFontFamilyFont ff (FontOptions _ fs fv fw fc) = FontOptions ff fs fv fw fc++changeFontStyleFont :: P.FontStyle -> FontOptions -> FontOptions+changeFontStyleFont fs (FontOptions ff _ fv fw fc) = FontOptions ff fs fv fw fc++changeFontVariantFont :: P.Variant -> FontOptions -> FontOptions+changeFontVariantFont fv (FontOptions ff fs _ fw fc) = FontOptions ff fs fv fw fc++changeFontWeightFont :: P.Weight -> FontOptions -> FontOptions+changeFontWeightFont fw (FontOptions ff fs fv _ fc) = FontOptions ff fs fv fw fc++changeFontStretchFont :: P.Stretch -> FontOptions -> FontOptions+changeFontStretchFont fc (FontOptions ff fs fv fw _) = FontOptions ff fs fv fw fc++changeFontOptionsFont :: (FontOptions -> FontOptions) -> TextOptions -> TextOptions+changeFontOptionsFont f (TextOptions fo fz c) = TextOptions (f fo) fz c++changeFontFamily :: FontFamily -> TextOptions -> TextOptions+changeFontFamily ff = changeFontOptionsFont $ changeFontFamilyFont ff++changeFontStyle :: P.FontStyle -> TextOptions -> TextOptions+changeFontStyle fs = changeFontOptionsFont $ changeFontStyleFont fs++changeFontVariant :: P.Variant -> TextOptions -> TextOptions+changeFontVariant fv = changeFontOptionsFont $ changeFontVariantFont fv++changeFontWeight :: P.Weight -> TextOptions -> TextOptions+changeFontWeight fw = changeFontOptionsFont $ changeFontWeightFont fw++changeFontStretch :: P.Stretch -> TextOptions -> TextOptions+changeFontStretch fc = changeFontOptionsFont $ changeFontStretchFont fc++changeFontSize :: FontSize -> TextOptions -> TextOptions+changeFontSize fz (TextOptions fo _ c) = TextOptions fo fz c++scaleFontSize :: Double -> TextOptions -> TextOptions+scaleFontSize sc (TextOptions fo fz c) = TextOptions fo (sc*fz) c++changeFontColour :: Color -> TextOptions -> TextOptions+changeFontColour c (TextOptions fo fz _) = TextOptions fo fz c++changeFontTextSize :: FontSize -> TextEntry -> TextEntry+changeFontTextSize fz (FontText to s) = FontText (changeFontSize fz to) s+changeFontTextSize _ _ = error "changeFontTextSize"++changeFontTextColour :: Color -> TextEntry -> TextEntry+changeFontTextColour c (FontText to s) = FontText (changeFontColour c to) s+changeFontTextColour _ _ = error "changeFontTextColour"++changeText :: String -> TextEntry -> TextEntry+changeText s NoText = BareText s +changeText s (BareText _) = BareText s+changeText s (SizeText fz c _) = SizeText fz c s+changeText s (FontText to _) = FontText to s++clearTextEntryFormat :: TextEntry -> TextEntry+clearTextEntryFormat NoText = NoText+clearTextEntryFormat t@(BareText _) = t+clearTextEntryFormat (SizeText _ _ s) = BareText s+clearTextEntryFormat (FontText _ s) = BareText s++-----------------------------------------------------------------------------++-- | clear the text entry +clearText :: Text ()+clearText = put NoText++-- | set the text formatting to the default+clearTextFormat :: Text ()+clearTextFormat = modify clearTextEntryFormat++-- | set the value of a text entry+setText :: String -> Text ()+setText l = modify (changeText l)++changeFontOptions :: (TextOptions -> TextOptions) -> TextEntry -> Text ()+changeFontOptions _ NoText = return ()+changeFontOptions o (BareText s) = do+ to <- ask+ put $ FontText (o to) s+changeFontOptions o (SizeText fz c s) = do+ to <- ask+ let (TextOptions fo _ _) = o to+ put $ FontText (TextOptions fo fz c) s+changeFontOptions o (FontText to s) = put $ FontText (o to) s+ ++-- | set the font style of a text entry+setFontFamily :: FontFamily -> Text ()+setFontFamily ff = get >>= changeFontOptions (changeFontFamily ff)++-- | set the font style of a text entry+setFontStyle :: P.FontStyle -> Text ()+setFontStyle fs = get >>= changeFontOptions (changeFontStyle fs)+ +-- | set the font variant of a text entry+setFontVariant :: P.Variant -> Text ()+setFontVariant fv = get >>= changeFontOptions (changeFontVariant fv)+ +-- | set the font weight of a text entry+setFontWeight :: P.Weight -> Text ()+setFontWeight fw = get >>= changeFontOptions (changeFontWeight fw)++-- | set the font stretch of a text entry+setFontStretch :: P.Stretch -> Text ()+setFontStretch fc = get >>= changeFontOptions (changeFontStretch fc)++-- | set the font size of a text entry+setFontSize :: FontSize -> Text ()+setFontSize fz = do+ t <- get+ case t of+ NoText -> return ()+ (BareText s) -> do+ (TextOptions _ _ c) <- ask+ put $ SizeText fz c s+ (SizeText _ c s) -> put $ SizeText fz c s+ (FontText to s) -> put $ FontText (changeFontSize fz to) s++-- | set the colour of a text entry+setFontColour :: Color -> Text ()+setFontColour c = do+ t <- get+ case t of+ NoText -> return ()+ (BareText s) -> do+ (TextOptions _ fz _) <- ask+ put $ SizeText fz c s+ (SizeText fz _ s) -> put $ SizeText fz c s+ (FontText to s) -> put $ FontText (changeFontColour c to) s++-----------------------------------------------------------------------------++
+ lib/Graphics/Rendering/Plot/Render.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render (+ -- * Rendering+ render+ -- ** Access to 'FigureState'+ , newFigureState+ , updateFigureState+ , renderFigureState+ -- ** Outputting to file+ , OutputType(..)+ , writeFigure+ , writeFigureState+ -- * Notes+ -- $notes+ ) where++-----------------------------------------------------------------------------+{- TODO++ store 'next colour' list in state+-}+-----------------------------------------------------------------------------++--import Data.Either++--import Data.Packed.Vector+--import Numeric.LinearAlgebra.Linear++--import Data.Word++--import Data.Maybe++--import Data.Colour.SRGB+--import Data.Colour.Names++--import qualified Data.Array.IArray as A++import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++--import Control.Monad.Reader+--import Control.Monad.State+--import Control.Monad.Trans++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults++--import Graphics.Rendering.Plot.Figure.Text++import Graphics.Rendering.Plot.Render.Types+import Graphics.Rendering.Plot.Render.Text+import Graphics.Rendering.Plot.Render.Plot++--import qualified Text.Printf as Printf++--import Prelude hiding(min,max)+--import qualified Prelude(max)++-----------------------------------------------------------------------------++-- | render a 'Figure'+render :: Figure () -- ^ the figure to be rendered+ -> (Int,Int) -- ^ (width,height)+ -> C.Render () -- ^ a Cairo operation+render g = (\(w,h) -> do+ pc <- pango $ P.cairoCreateContext Nothing+ to <- pango $ getDefaultTextOptions pc+ let options' = Options defaultLineOptions defaultPointOptions defaultBarOptions to+ let (FigureState options _ figure) = execFigure g (FigureState options' defaultSupply emptyFigure)+ evalRender (renderFigure figure) (RenderEnv pc options) (BoundingBox 0 0 (fromIntegral w) (fromIntegral h)))++-----------------------------------------------------------------------------++-- | create 'FigureState' from a series of 'Figure' actions+newFigureState :: Figure () -> IO FigureState+newFigureState f = do+ pc <- P.cairoCreateContext Nothing+ to <- getDefaultTextOptions pc+ let options' = Options defaultLineOptions defaultPointOptions defaultBarOptions to+ return $ execFigure f (FigureState options' defaultSupply emptyFigure)+ +-- | modify a 'FigureState' with some new actions +updateFigureState :: FigureState -> Figure () -> FigureState+updateFigureState s f = execFigure f s++-- | render a 'FigureState'+renderFigureState :: FigureState -- ^ the figure state+ -> (Int,Int) -- ^ (width,height)+ -> C.Render () -- ^ a Cairo operation+renderFigureState (FigureState options _ figure) = (\(w,h) -> do+ pc <- pango $ P.cairoCreateContext Nothing+ evalRender (renderFigure figure) (RenderEnv pc options) (BoundingBox 0 0 (fromIntegral w) (fromIntegral h))) ++-----------------------------------------------------------------------------++-- | output the 'Figure'+writeFigure :: OutputType -- ^ output file type+ -> FilePath -- ^ file path+ -> (Int,Int) -- ^ (width,height)+ -> Figure () -- ^ the 'Figure' rendering operation+ -> IO ()+writeFigure PNG fn wh f = withImageSurface wh (writeSurfaceToPNG fn (render f wh))+writeFigure PS fn wh f = writeSurface C.withPSSurface fn wh f+writeFigure PDF fn wh f = writeSurface C.withPDFSurface fn wh f+writeFigure SVG fn wh f = writeSurface C.withSVGSurface fn wh f++withImageSurface :: (Int,Int) -> (C.Surface -> IO ()) -> IO ()+withImageSurface (w,h) = C.withImageSurface C.FormatARGB32 w h++writeSurfaceToPNG :: FilePath -> C.Render () -> C.Surface -> IO ()+writeSurfaceToPNG fn r s = do+ C.renderWith s r+ C.surfaceWriteToPNG s fn++writeSurface :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) + -> FilePath -> (Int,Int) -> Figure () -> IO ()+writeSurface rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) (flip C.renderWith (render f (w,h))) + +-----------------------------------------------------------------------------++-- | output the 'FigureState'+writeFigureState :: OutputType -- ^ output file type+ -> FilePath -- ^ file path+ -> (Int,Int) -- ^ (width,height)+ -> FigureState -- ^ a FigureState+ -> IO ()+writeFigureState PNG fn wh f = withImageSurface wh (writeSurfaceToPNG fn (renderFigureState f wh))+writeFigureState PS fn wh f = writeSurfaceFS C.withPSSurface fn wh f+writeFigureState PDF fn wh f = writeSurfaceFS C.withPDFSurface fn wh f+writeFigureState SVG fn wh f = writeSurfaceFS C.withSVGSurface fn wh f++writeSurfaceFS :: (FilePath -> Double -> Double -> (C.Surface -> IO ()) -> IO ()) + -> FilePath -> (Int,Int) -> FigureState -> IO ()+writeSurfaceFS rw fn (w,h) f = rw fn (fromIntegral w) (fromIntegral h) (flip C.renderWith (renderFigureState f (w,h))) + +-----------------------------------------------------------------------------++renderFigure :: FigureData -> Render ()+renderFigure (Figure p t s d) = do+ cairo $ do+ C.save + C.setSourceRGBA 1 1 1 1+ C.paint+ C.restore++ applyPads p++ tx <- bbCentreWidth+ ty <- bbTopHeight+ (_,th) <- renderText t Centre TTop tx ty+ bbLowerTop (th+textPad)++ sx <- bbCentreWidth+ sy <- bbTopHeight+ (_,sh) <- renderText s Centre TTop sx sy+ bbLowerTop (sh+textPad)++ renderPlots d+
+ lib/Graphics/Rendering/Plot/Render/Plot.hs view
@@ -0,0 +1,129 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Plot+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Plot (+ -- * Rendering+ renderPlots+ ) where++-----------------------------------------------------------------------------++--import Data.Either++--import Data.Packed.Vector+--import Numeric.LinearAlgebra.Linear++--import Data.Word++--import Data.Maybe++--import Data.Colour.SRGB+--import Data.Colour.Names++import qualified Data.Array.IArray as A++import qualified Graphics.Rendering.Cairo as C+--import qualified Graphics.Rendering.Pango as P++--import Control.Monad.Reader+import Control.Monad.State+--import Control.Monad.Trans++import Graphics.Rendering.Plot.Types+--import Graphics.Rendering.Plot.Defaults++--import Graphics.Rendering.Plot.Figure.Text++import Graphics.Rendering.Plot.Render.Types++import Graphics.Rendering.Plot.Render.Text+import Graphics.Rendering.Plot.Render.Plot.Axis+import Graphics.Rendering.Plot.Render.Plot.Data+import Graphics.Rendering.Plot.Render.Plot.Legend++--import qualified Text.Printf as Printf++--import Prelude hiding(min,max)+--import qualified Prelude(max)++-----------------------------------------------------------------------------++bbPlot :: Int -> Int -> (Int,Int) -> Render ()+bbPlot r c (px,py) = modify (\(BoundingBox x y w h) -> let w' = w/(fromIntegral c)+ h' = h/(fromIntegral r)+ in (BoundingBox+ (x+w'*((fromIntegral py)-1))+ (y+h'*((fromIntegral px)-1))+ w' h'))++renderPlots :: Plots -> Render ()+renderPlots d = do+ let ((x,y),(x',y')) = A.bounds d+ rows = x'-x+1+ cols = y'-y+1+ bb <- get+ mapM_ (\(i,e) -> do+ case e of+ Nothing -> return ()+ Just e' -> do+ bbPlot rows cols i+ renderPlot e'+ put bb) (A.assocs d)++renderPlot :: PlotData -> Render ()+renderPlot (Plot b p hd r a d l an) = do+ tx <- bbCentreWidth+ ty <- bbTopHeight+ (_,th) <- renderText hd Centre TTop tx ty+ bbLowerTop (th+textPad)+{- attempt to have different colour plot area+ (BoundingBox x y w h) <- get+ cairo $ do+ setColour white+ C.moveTo x y+ C.lineTo (x+w) y+ C.lineTo (x+w) (y+h)+ C.lineTo x (y+h)+ C.stroke+ C.clip+ C.fill+ C.paint+-}+ + legend <- renderLegend l d+ padding <- renderAxes p r a+ renderBorder b+ cairo C.save+ clipBoundary+ renderData r d+ renderAnnotations r an+ cairo C.restore+ legend padding++renderBorder :: Border -> Render ()+renderBorder False = return ()+renderBorder True = do+ (BoundingBox x y w h) <- get+ cairo $ do+ C.setLineWidth 0.5+ C.rectangle (x+0.5) (y+0.5) w h+ C.stroke+ +-----------------------------------------------------------------------------++renderAnnotations :: Ranges -> [Annotation] -> Render ()+renderAnnotations _ _ = return ()++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs view
@@ -0,0 +1,445 @@+{-# LANGUAGE UnicodeSyntax #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Plot.Axis+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Plot.Axis (+ -- * Rendering+ renderAxes+ ) where++-----------------------------------------------------------------------------++import Data.Eq.Unicode+import Data.Function.Unicode+import Prelude.Unicode++import Data.Either++import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++import Control.Monad.Reader+import Control.Monad.State++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults++import Graphics.Rendering.Plot.Figure.Text++import Graphics.Rendering.Plot.Render.Types+import Graphics.Rendering.Plot.Render.Text++import qualified Text.Printf as Printf++import Prelude hiding(min,max)+import qualified Prelude(max)++-----------------------------------------------------------------------------++addPadding :: Padding -> Padding -> Padding+addPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = Padding (l0+l1) (r0+r1) (b0+b1) (t0+t1)++maxPadding :: Padding -> Padding -> Padding+maxPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = Padding (Prelude.max l0 l1) (Prelude.max r0 r1) (Prelude.max b0 b1) (Prelude.max t0 t1)++-- first is plot padding, second is calculated padding+isZeroPadding :: Padding -> Padding -> Render Padding+isZeroPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = do+ l <- if l1 == 0 then do+ bbShiftLeft l0+ return l0+ else if l0 > l1 then do+ bbShiftLeft (l0 - l1)+ return l0+ else return l1+ r <- if r1 == 0 then do+ bbShiftRight r0+ return r0+ else if r0 > r1 then do+ bbShiftRight (r0 - r1)+ return r0+ else return r1+ b <- if b1 == 0 then do+ bbRaiseBottom b0+ return b0+ else if b0 > b1 then do+ bbRaiseBottom (b0 - b1)+ return b0+ else return b1+ t <- if t1 == 0 then do+ bbLowerTop t0+ return t0+ else if t0 > t1 then do+ bbLowerTop (t0 - t1)+ return t0+ else return t1+ return $ Padding l r b t+++renderAxes :: Padding -> Ranges -> [AxisData] -> Render Padding+renderAxes p r axes = do+ lp <- foldM shiftForAxisLabel (Padding 0 0 0 0) axes+ tp <- foldM (shiftForTicks r) (Padding 0 0 0 0) axes+ let apd = addPadding lp tp+ p' <- isZeroPadding p apd+ mapM_ (renderAxisLabel p') axes+ mapM_ (renderAxis r) axes+ return p'++shiftForAxisLabel :: Padding -> AxisData -> Render Padding+shiftForAxisLabel p (Axis _ _ _ _ _ _ NoText) = return p+shiftForAxisLabel p (Axis ax sd _ _ _ _ lb) = do+ (FontText to s) <- formatText lb+ pc <- asks _pangocontext+ (w,h) <- cairo $ do+ lo <- pango $ P.layoutText pc s+ setTextOptions to lo+ case ax of+ XAxis -> do+ (_,(twh)) <- textSize lo Centre Middle 0 0+ return twh+ YAxis -> do+ (_,((w',h'))) <- textSizeVertical lo Centre Middle 0 0+ return (h',w')+ shiftForAxisLabel' p ax sd w h + where shiftForAxisLabel' (Padding l r b t) XAxis (Side Lower) _ h' = do+ bbRaiseBottom (h'+2*textPad)+ return $ Padding l r (b+h'+2*textPad) t+ shiftForAxisLabel' (Padding l r b t) XAxis (Side Upper) _ h' = do+ bbLowerTop (h'+2*textPad)+ return $ Padding l r b (t+h'+2*textPad)+ shiftForAxisLabel' (Padding l r b t) YAxis (Side Lower) w' _ = do+ bbShiftLeft (w'+2*textPad)+ return $ Padding (l+w'+2*textPad) r b t+ shiftForAxisLabel' (Padding l r b t) YAxis (Side Upper) w' _ = do+ bbShiftRight (w'+2*textPad)+ return $ Padding l (r+w'+2*textPad) b t+ shiftForAxisLabel' p' _ (Value _) _ _ = return p'++-- the padding is the tick padding that has been applied+renderAxisLabel :: Padding -> AxisData -> Render ()+renderAxisLabel _ (Axis _ _ _ _ _ _ NoText) = return ()+renderAxisLabel (Padding _ _ b _) (Axis XAxis (Side Lower) _ _ _ _ la) = do+ lx <- bbCentreWidth+ ly <- bbBottomHeight+ _ <- renderText la Centre TBottom lx (ly+b-textPad)+ return ()+renderAxisLabel (Padding _ _ _ t) (Axis XAxis (Side Upper) _ _ _ _ la) = do+ lx <- bbCentreWidth+ ly <- bbTopHeight+ _ <- renderText la Centre TTop lx (ly-t+textPad)+ return ()+renderAxisLabel (Padding l _ _ _) (Axis YAxis (Side Lower) _ _ _ _ la) = do+ lx <- bbLeftWidth+ ly <- bbCentreHeight+ _ <- renderTextVertical la TRight Middle (lx-l-2*textPad) ly+ return ()+renderAxisLabel (Padding _ r _ _) (Axis YAxis (Side Upper) _ _ _ _ la) = do+ lx <- bbRightWidth+ ly <- bbCentreHeight+ _ <- renderTextVertical la TLeft Middle (lx+r+2*textPad) ly+ return ()+renderAxisLabel _ (Axis _ (Value _) _ _ _ _ _) = return ()++shiftForTicks :: Ranges -> Padding -> AxisData -> Render Padding+shiftForTicks (Ranges (Left (Range _ xmin xmax)) _)+ p (Axis XAxis (Side Lower) _ min maj tf _) + = shiftForTicks' p min maj XAxis (Side Lower) tf (negate $ Prelude.max (abs xmin) (abs xmax))+shiftForTicks (Ranges (Left (Range _ xmin xmax)) _)+ p (Axis XAxis (Side Upper) _ min maj tf _) + = shiftForTicks' p min maj XAxis (Side Upper) tf (negate $ Prelude.max (abs xmin) (abs xmax))+shiftForTicks (Ranges (Right ((Range _ xmin xmax),_)) _)+ p (Axis XAxis (Side Lower) _ min maj tf _) + = shiftForTicks' p min maj XAxis (Side Lower) tf (negate $ Prelude.max (abs xmin) (abs xmax))+shiftForTicks (Ranges (Right (_,(Range _ xmin xmax))) _)+ p (Axis XAxis (Side Upper) _ min maj tf _) + = shiftForTicks' p min maj XAxis (Side Upper) tf (negate $ Prelude.max (abs xmin) (abs xmax))+shiftForTicks (Ranges _ (Left (Range _ ymin ymax)))+ p (Axis YAxis (Side Lower) _ min maj tf _) + = shiftForTicks' p min maj YAxis (Side Lower) tf (negate $ Prelude.max (abs ymin) (abs ymax))+shiftForTicks (Ranges _ (Left (Range _ ymin ymax)))+ p (Axis YAxis (Side Upper) _ min maj tf _) + = shiftForTicks' p min maj YAxis (Side Upper) tf (negate $ Prelude.max (abs ymin) (abs ymax))+shiftForTicks (Ranges _ (Right ((Range _ ymin ymax),_)))+ p (Axis YAxis (Side Lower) _ min maj tf _) + = shiftForTicks' p min maj YAxis (Side Lower) tf (negate $ Prelude.max (abs ymin) (abs ymax))+shiftForTicks (Ranges _ (Right (_,(Range _ ymin ymax))))+ p (Axis YAxis (Side Upper) _ min maj tf _) + = shiftForTicks' p min maj YAxis (Side Upper) tf (negate $ Prelude.max (abs ymin) (abs ymax))+shiftForTicks _ p (Axis _ (Value _) _ _ _ _ _) + = return p++shiftForTicks' :: Padding -> Ticks -> Ticks -> AxisType -> AxisPosn -> TickFormat -> Double -> Render Padding+shiftForTicks' p (Ticks _ (Left 0)) (Ticks _ (Left 0)) _ _ _ _ = return p+shiftForTicks' p (Ticks _ (Left _)) (Ticks _ (Left 0)) _ _ _ _ = return p+{-+shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) XAxis (Side Lower) _ _ = do+ bbRaiseBottom minorTickLength+ return $ Padding l r (b+minorTickLength) t+shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) YAxis (Side Lower) _ _ = do+ bbShiftLeft minorTickLength+ return $ Padding (l+minorTickLength) r b t+shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) XAxis (Side Upper) _ _ = do+ bbLowerTop minorTickLength+ return $ Padding l r b (t+minorTickLength)+shiftForTicks' (Padding l r b t) (Ticks _ (Left _)) (Ticks _ (Left 0)) YAxis (Side Upper) _ _ = do+ bbShiftRight minorTickLength+ return $ Padding l (r+minorTickLength) b t+-}+shiftForTicks' p (Ticks _ _) (Ticks _ _) ax sd tf v = do+ to <- asks (_textoptions . _renderoptions)+ pc <- asks _pangocontext+ (tw,th) <- cairo $ do+ let s = formatTick tf v+ lt <- pango $ P.layoutText pc s+ setTextOptions (scaleFontSize tickLabelScale to) lt+ (_,twh) <- textSize lt Centre Middle 0 0+ return twh+ shiftForTicks'' p (tw,th) ax sd+ where shiftForTicks'' (Padding l r b t) (_,th) XAxis (Side Lower) = do+ bbRaiseBottom (th+2*textPad)+ return $ Padding l r (b+th+2*textPad) t+ shiftForTicks'' (Padding l r b t) (tw,_) YAxis (Side Lower) = do+ bbShiftLeft (tw+2*textPad)+ return $ Padding (l+tw+2*textPad) r b t+ shiftForTicks'' (Padding l r b t) (_,th) XAxis (Side Upper) = do+ bbLowerTop (th+2*textPad)+ return $ Padding l r b (t+th+2*textPad)+ shiftForTicks'' (Padding l r b t) (tw,_) YAxis (Side Upper) = do+ bbShiftRight (tw+2*textPad)+ return $ Padding l (r+tw+2*textPad) b t+ shiftForTicks'' p' (_,_) _ (Value _) = return p'++renderAxis :: Ranges -> AxisData -> Render ()+renderAxis _ (Axis _ _ NoLine _ _ _ _) = return () +renderAxis r (Axis ax sd + (ColourLine c) + min maj tf l) = do+ lo <- asks (_lineoptions . _renderoptions)+ renderAxis r (Axis ax sd (TypeLine lo c) min maj tf l)+renderAxis r (Axis ax sd lt+ min maj tf _) = do+ cairo $ setLineStyle lt+ renderAxisLine r ax sd+ cairo $ do+ lw' <- C.getLineWidth+ C.setLineWidth (lw'/2)+ renderAxisTicks r ax sd min maj tf + return ()++lowerRange :: Either Range (Range,Range) -> Range+lowerRange (Left r@(Range _ _ _)) = r+lowerRange (Right (r@(Range _ _ _),_)) = r++renderAxisLine :: Ranges -> AxisType -> AxisPosn -> Render ()+renderAxisLine (Ranges _ yr) XAxis (Value v) = do+ let (Range _ min max) = lowerRange yr + (BoundingBox x y w h) <- get+ cairo $ do+ C.moveTo x (y+h*((v-min)/(max-min))+0.5)+ C.lineTo (x+w) (y+h*((v-min)/(max-min))+0.5)+ C.stroke+renderAxisLine (Ranges xr _) YAxis (Value v) = do+ let (Range _ min max) = lowerRange xr + (BoundingBox x y w h) <- get+ cairo $ do+ C.moveTo (x+w*((v-min)/(max-min))+0.5) y+ C.lineTo (x+w*((v-min)/(max-min))+0.5) (y+h)+ C.stroke+renderAxisLine _ XAxis (Side Lower) = do+ (BoundingBox x y w h) <- get+ cairo $ do+ C.moveTo x (y+h+0.5)+ C.lineTo (x+w) (y+h+0.5)+ C.stroke+renderAxisLine _ XAxis (Side Upper) = do+ (BoundingBox x y w _) <- get+ cairo $ do+ C.moveTo x (y+0.5)+ C.lineTo (x+w) (y+0.5)+ C.stroke+renderAxisLine _ YAxis (Side Lower) = do+ (BoundingBox x y _ h) <- get+ cairo $ do+ C.moveTo (x+0.5) y+ C.lineTo (x+0.5) (y+h)+ C.stroke+renderAxisLine _ YAxis (Side Upper) = do+ (BoundingBox x y w h) <- get+ cairo $ do+ C.moveTo (x+w+0.5) (y)+ C.lineTo (x+w+0.5) (y+h)+ C.stroke++tickPosition :: Scale → Double -> Double -> Int -> [(Double,Double)]+tickPosition sc min max n = let pos = map (\x -> min + (max-min)*(x)/(fromIntegral (n-1))) (take n [(0 ∷ Double)..])+ val = if sc ≡ Log+ then map (\x → logBase 10 min + (x÷(fromIntegral (n-1))) ⋅ (logBase 10 max - logBase 10 min))+ (take n [(0 ∷ Double)..])+ else pos+ in zip pos val+{-+tickPosition min max n = let diff = max - min+ (sc,sd) = scaleDiff 1.0 diff n+ start = (round (min*sc)) `div` (fromIntegral sd)+ in map (\x -> (fromIntegral (x*sd+start))/sc) (take n [0..])+ where scaleDiff :: Double -> Double -> Int -> (Double,Int)+ scaleDiff s diff n+ | (round (s*diff)) < n = scaleDiff (10*s) (10*diff) n+ | otherwise = (s,(round diff) `div` n)+-}+renderAxisTicks :: Ranges -> AxisType -> AxisPosn -> Ticks -> Ticks -> TickFormat -> Render ()+renderAxisTicks (Ranges xrange yrange) ax sd+ (Ticks gmin (Left tmin)) (Ticks gmaj (Left tmaj)) tf = do+ (BoundingBox x y w h) <- get+ to <- asks (_textoptions . _renderoptions)+ pc <- asks _pangocontext+ cairo $ do+ let (sc,min,max) = case ax of+ XAxis -> case sd of+ (Side Lower) -> case xrange of+ (Left (Range scl xmin xmax)) -> (scl,xmin,xmax)+ (Right (Range scl xmin xmax,_)) -> (scl,xmin,xmax)+ (Side Upper) -> case xrange of+ (Left (Range scl xmin xmax)) -> (scl,xmin,xmax)+ (Right (_,Range scl xmin xmax)) -> (scl,xmin,xmax)+ (Value _) -> case xrange of+ (Left (Range scl xmin xmax)) -> (scl,xmin,xmax)+ (Right (Range scl xmin xmax,_)) -> (scl,xmin,xmax) + YAxis -> case sd of+ (Side Lower) -> case yrange of+ (Left (Range scl ymin ymax)) -> (scl,ymin,ymax)+ (Right (Range scl ymin ymax,_)) -> (scl,ymin,ymax)+ (Side Upper) -> case yrange of+ (Left (Range scl ymin ymax)) -> (scl,ymin,ymax)+ (Right (_,Range scl ymin ymax)) -> (scl,ymin,ymax)+ (Value _) -> case yrange of+ (Left (Range scl ymin ymax)) -> (scl,ymin,ymax)+ (Right (Range scl ymin ymax,_)) -> (scl,ymin,ymax)+ -- convert axis position to non-data coordinates+ let sd' = case sd of+ (Side _) -> sd+ (Value v) -> case ax of+ XAxis -> let (Range _ b t) = lowerRange yrange+ in Value (y+h*(t-v)/(t-b))+ YAxis -> let (Range _ b t) = lowerRange xrange+ in Value (x+w*(v-b)/(t-b))+ let (pos,val) = unzip (tickPosition sc min max tmaj) + let majpos = let ones = 1.0 : ones+ ln = length pos+ in zip3 pos (take ln ones) val+ (pos',val') = unzip (tickPosition sc min max tmin)+ minpos' = zip3 pos' (minorTickLengths tmin tmaj) val'+ minpos = filter (not . (\(p,_,_) -> elem p pos)) minpos' + let renderAxisTick' = renderAxisTick pc to x y w h sc min max ax sd' tf+ mapM_ (renderAxisTick' Minor gmin) minpos + mapM_ (renderAxisTick' Major gmaj) majpos+ return ()+ return ()++minorTickLengths :: Int -> Int -> [Double]+minorTickLengths min maj = let num = (min-1) `div` (maj-1)+ in map ((/ 2) . (+ 1) . (* 2) . (/ (fromIntegral num)) . fromIntegral . (\x -> if x > (num `div` 2) then num - x else x) . (`mod` num)) (take (min+1) [0..])+ --map ((/) 2 . (+) 1 . (/) (fromIntegral tmaj) . fromIntegral . (mod tmaj)) (take (tmin+1) [0..])++renderAxisTick :: P.PangoContext -> TextOptions + -> Double -> Double -> Double -> Double -> Scale → Double -> Double+ -> AxisType -> AxisPosn -> TickFormat -> Tick -> GridLines+ -> (Double,Double,Double) -> C.Render ()+renderAxisTick pc to x y w h sc min max xa sd tf t gl (p,l,v) = do+ let tl' = case t of+ Minor -> minorTickLength+ Major -> majorTickLength+ tl = tl' * l+ (x1,y1,x2,y2) = case xa of+ XAxis -> case sd of+ (Side Lower) -> let xt x' = x + (x'-min)*w/(max-min)+ in (xt p+0.5,y+h,xt p+0.5,y+h-tl)+ (Side Upper) -> let xt x' = x + (x'-min)*w/(max-min)+ in (xt p+0.5,y,xt p+0.5,y+tl)+ (Value v) -> let xt x' = x + (x'-min)*w/(max-min)+ in (xt p+0.5,v-tl,xt p+0.5,v+tl)+ YAxis -> case sd of+ (Side Lower) -> let yt y' = (y+h) - (y'-min)*h/(max-min)+ in (x,yt p+0.5,x+tl,yt p+0.5)+ (Side Upper) -> let yt y' = (y+h) - (y'-min)*h/(max-min)+ in (x+w,yt p+0.5,x+w-tl,yt p+0.5)+ (Value v) -> let yt y' = (y + h) - (y'-min)*h/(max-min)+ in (v-tl,yt p+0.5,v+tl,yt p+0.5)+ C.moveTo x1 y1+ C.lineTo x2 y2+ C.stroke+ when gl (do+ let (x3,y3,x4,y4) = case xa of+ XAxis -> case sd of+ (Side Lower) -> let xt x' = x + (x'-min)*w/(max-min)+ in (xt p+0.5,y,xt p+0.5,y+h)+ (Side Upper) -> let xt x' = x + (x'-min)*w/(max-min)+ in (xt p+0.5,y,xt p+0.5,y+h)+ (Value _) -> let xt x' = x + (x'-min)*w/(max-min)+ in (xt p+0.5,y,xt p+0.5,y+h)+ YAxis -> case sd of+ (Side Lower) -> let yt y' = (y+h) - (y'-min)*h/(max-min)+ in (x,yt p+0.5,x+w,yt p+0.5)+ (Side Upper) -> let yt y' = (y+h) - (y'-min)*h/(max-min)+ in (x,yt p+0.5,x+w,yt p+0.5)+ (Value _) -> let yt y' = (y + h) - (y'-min)*h/(max-min)+ in (x,yt p+0.5,x+w,yt p+0.5)+ C.save+ C.setDash [2,2] 0+ C.setSourceRGBA 0 0 0 0.6+ C.moveTo x3 y3+ C.lineTo x4 y4+ C.stroke+ C.restore)+ let majlab = case sd of + (Side _) -> True+ (Value _) -> False+ when (t == Major && majlab) $ do+ let s = if sc ≡ Log then formatTick "10e%.1g" v else formatTick tf v+ lo <- pango $ P.layoutText pc s+ setTextOptions (scaleFontSize tickLabelScale to) lo+ case xa of + XAxis -> do+ case sd of+ (Side Lower) -> do+ ((x',y'),_) <- textSize lo Centre TTop x1 (y1+2*textPad)+ showText lo x' y'+ (Side Upper) -> do+ ((x',y'),_) <- textSize lo Centre TBottom x1 (y1-2*textPad)+ showText lo x' y'+ (Value _) -> error "renderAxisTicks: unreachable code (when majlab)"+ YAxis -> do+ case sd of+ (Side Lower) -> do+ ((x',y'),_) <- textSize lo TLeft Middle (x1-2*textPad) y1+ showText lo x' y'+ (Side Upper) -> do+ ((x',y'),_) <- textSize lo TRight Middle (x1+2*textPad) y1+ showText lo x' y'+ (Value _) -> error "renderAxisTicks: unreachable code (when majlab)"+ return ()++-----------------------------------------------------------------------------++formatTick :: String -> Double -> String+formatTick tf p+ | tf /= "" = Printf.printf tf p + | p == 0.0 = "0"+ | abs p > 1000 = Printf.printf "%1.1e" p+ | abs p < 0.001 = Printf.printf "%.3e" p+ | otherwise = Printf.printf "%.2f" p+-- %g uses "whichever of %f, %e is smaller++-----------------------------------------------------------------------------
+ lib/Graphics/Rendering/Plot/Render/Plot/Data.hs view
@@ -0,0 +1,403 @@+{-# LANGUAGE UnicodeSyntax #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Plot.Data+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Plot.Data (+ -- * Rendering+ renderData+ ) where++-----------------------------------------------------------------------------++import Data.List(partition)+import Data.List.Unicode++--import Data.Packed.Vector+--import Data.Packed.Matrix+--import Data.Packed()+import Numeric.LinearAlgebra++import qualified Data.Array.IArray as A+import qualified Data.Array.MArray as M+import qualified Data.Array.Base as B++import Data.Eq.Unicode++import Data.Word++import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.Matrix as CM++import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Maybe++import Graphics.Rendering.Plot.Types++import Graphics.Rendering.Plot.Render.Types+import Graphics.Rendering.Plot.Render.Plot.Glyph++import Prelude hiding(min,max,abs)+import qualified Prelude++-----------------------------------------------------------------------------++findMinIdx, findMaxIdx :: Vector Double -> Double -> Int -> Int -> Int+findMinIdx v x n max+ | n >= max = error "data not in range"+ | v @> n >= x = n+ | otherwise = findMinIdx v x (n+1) max++findMaxIdx v x n min+ | n < 0 = error "data not in range"+ | v @> n <= x = n+ | otherwise = findMaxIdx v x (n-1) min++flipVerticalMatrix :: CM.Matrix+flipVerticalMatrix = CM.Matrix 1 0 0 (-1) 0 0++flipVertical :: C.Render ()+flipVertical = C.transform flipVerticalMatrix++-----------------------------------------------------------------------------++greySurfaceFromMatrix :: C.SurfaceData Int Word8 -> Surface -> Int -> Int -> Int -> IO ()+greySurfaceFromMatrix s m stride r' c' = do+ let r = rows m+ c = cols m+ let fm = flatten m+ mx = maxElement m+ mn = minElement m+ mapM_ (\ri -> mapM_ (\(rj,ci) -> do+ let mi = ((rj `div` r')*c) + (ci `div` c')+ let e = round . (* 255) . (/ (mx-mn)) . (\x -> x - mn) $ (fm @> mi)+ let si = (rj*stride) + ci+ B.unsafeWrite s si e) $ zip (repeat ri) [0..((c*c')-1)]) [0..((r*r')-1)]+++-----------------------------------------------------------------------------++renderData :: Ranges -> DataSeries -> Render ()+renderData _ (DS_Surf m) = do+ (BoundingBox x y w h) <- get+ let r = rows m+ c = cols m+ cairo $ do+ C.save+ --C.setAntialias C.AntialiasNone+ let r'' = Prelude.min 4 ((round h) `div` r)+ c'' = Prelude.min 4 ((round w) `div` c)+ r' = if r'' < 1 then 1 else r''+ c' = if c'' < 1 then 1 else c''+ s <- liftIO $ C.createImageSurface C.FormatA8 (c*c') (r*r')+ p <- liftIO $ C.imageSurfaceGetPixels s+ C.surfaceFlush s+ stride <- liftIO $ C.imageSurfaceGetStride s+ liftIO $ greySurfaceFromMatrix p m stride r' c'+ C.surfaceMarkDirty s+ C.setSourceSurface s x y+ pa <- C.getSource+ pm <- liftIO $ C.patternGetMatrix pa+ let pm' = CM.scale ((fromIntegral (c*c'))/w) ((fromIntegral (r*r'))/h) pm+ liftIO $ C.patternSetMatrix pa pm'+ --C.patternSetFilter pa C.FilterBest+ C.rectangle x y w h --(fromIntegral c) (fromIntegral r)+ C.paint+ C.stroke+ C.restore+ return ()++renderData r ds = do+ let aos = case ds of+ (DS_Y os') -> zip (repeat AbsFunction) (A.elems os')+ (DS_1toN abs' os') -> zip (repeat abs') (A.elems os') + (DS_1to1 aos') -> A.elems aos'+ _ -> error "renderData: DataSeries not handled"+ let (los,ups) = partition (\(_,DecSeries o _) -> isLower o) aos+ (BoundingBox x y w h) <- get+ let (xsc,xmin',xmax') = getRanges XAxis Lower r+ let (xmin,xmax) = if xsc ≡ Log then (logBase 10 xmin',logBase 10 xmax') else (xmin',xmax')+ let xscale = w/(xmax-xmin) + cairo $ C.save+ let (yscl,yminl',ymaxl') = getRanges YAxis Lower r+ let (yminl,ymaxl) = if yscl ≡ Log then (logBase 10 yminl',logBase 10 ymaxl') else (yminl',ymaxl')+ let yscalel = h/(ymaxl-yminl) + -- transform to data coordinates+ cairo $ do + C.translate x (y+h)+ C.scale xscale yscalel+ C.translate (-xmin) yminl+ flipVertical+ mapM_ (renderSeries xsc yscl xmin xmax xscale yscalel) los+ cairo $ C.restore+ when (not $ null ups)+ (do+ cairo $ C.save+ let (yscu,yminu',ymaxu') = getRanges YAxis Upper r+ let (yminu,ymaxu) = if yscu ≡ Log then (logBase 10 yminu',logBase 10 ymaxu') else (yminu',ymaxu')+ let yscaleu = h/(ymaxu-yminu) + -- transform to data coordinates+ cairo $ do + C.translate x (y+h)+ C.scale xscale yscaleu+ C.translate xmin yminu+ flipVertical+ mapM_ (renderSeries xsc yscu xmin xmax xscale yscaleu) ups)+ -- could filter annotations as well+ return ()++renderSeries :: Scale -> Scale + -> Double -> Double -> Double -> Double + -> (Abscissae,DecoratedSeries) -> Render ()+renderSeries xsc ysc xmin xmax xscale yscale (abs,(DecSeries o d)) = do+ dat' <- case o of+ (OrdFunction _ f _) -> do+ (BoundingBox _ _ w _) <- get+ let t = linspace (round w) (xmin,xmax)+ return $ [(t,mapVector f t)]+ (OrdPoints _ (Plain o') _) -> do+ let t = case abs of+ AbsFunction -> if isHist d+ then fromList [0.0..(fromIntegral $ dim o')]+ else fromList [1.0..(fromIntegral $ dim o')]+ AbsPoints t' -> t'+ return $ [(t,o')]+ (OrdPoints _ (Error o' (l,h)) _) -> do+ let t = case abs of+ AbsFunction -> if isHist d+ then fromList [0.0..(fromIntegral $ dim o')]+ else fromList [1.0..(fromIntegral $ dim o')]+ AbsPoints t' -> t'+ return $ [(t,o'),(t,o'-l),(t,o'+h)]+ let dat = map (\(a,b) → (if xsc ≡ Log then (logBase 10 a) else a+ ,if ysc == Log then (logBase 10 b) else b)) dat' + case d of+ (DecLine lt) -> do+ formatLineSeries lt xscale yscale+ mapM_ (\(t',y') -> renderSamples xmin xmax Nothing + renderLineSample endLineSample t' y') dat+ (DecPoint pt) -> do+ (pz,g) <- formatPointSeries pt xscale yscale+ let gs = g : Bot : Top : []+ mapM_ (\(g',(t',y')) -> renderSamples xmin xmax Nothing + (renderPointSample xscale yscale pz g') endPointSample t' y') (zip gs dat)+ (DecLinPt lt pt) -> do+ formatLineSeries lt xscale yscale+ mapM_ (\(t',y') -> renderSamples xmin xmax Nothing + renderLineSample endLineSample t' y') dat+ (pz,g) <- formatPointSeries pt xscale yscale+ let gs = g : Bot : Top : []+ mapM_ (\(g',(t',y')) -> renderSamples xmin xmax Nothing + (renderPointSample xscale yscale pz g') endPointSample t' y') (zip gs dat)+ (DecImpulse lt) -> do+ formatLineSeries lt xscale yscale+ mapM_ (\(t',y') -> renderSamples xmin xmax Nothing + renderImpulseSample endImpulseSample t' y') dat+ (DecStep lt) -> do+ formatLineSeries lt xscale yscale+ mapM_ (\(t',y') -> renderSamples xmin xmax Nothing + renderStepSample endStepSample t' y') dat+ (DecArea lt) -> do+ formatLineSeries lt xscale yscale+ let hd = head dat+ ln = dim $ fst hd+ xmin_ix = findMinIdx (fst hd) xmin 0 (ln-1)+ x0 = (fst hd) @> xmin_ix+ y0 = (snd hd) @> xmin_ix+ mapM_ (\(t',y') -> renderSamples xmin xmax Nothing + renderAreaSample (endAreaSample x0 y0) t' y') dat+ (DecBar bt) -> do+ (bw,bc,c) <- formatBarSeries bt xscale yscale+ mapM_ (\(t',y') -> renderSamples xmin xmax Nothing + (renderBarSample bw bc c) endBarSample t' y') dat+ (DecHist bt) -> do+ (bw,bc,c) <- formatBarSeries bt xscale yscale+ let hd = head dat+ ln = dim $ fst hd+ xmin_ix = findMinIdx (fst hd) xmin 0 (ln-1)+ rest v = subVector 1 (dim v - 1) v+ x0 = (fst hd) @> xmin_ix+ y0 = 0+ mapM_ (\(t',y') -> renderSamples xmin xmax (Just $ C.moveTo x0 y0) + (renderHistSample bw bc c) endHistSample (rest t') y') dat+ return ()++-----------------------------------------------------------------------------++formatLineSeries' :: [Dash] -> LineWidth -> Color -> C.Render ()+formatLineSeries' ds lw c = do+ setDashes ds+ C.setLineWidth lw + setColour c++formatLineSeries :: LineType -> Double -> Double -> Render ()+formatLineSeries NoLine _ _ = error "line format of NoLine in a line series"+formatLineSeries (ColourLine c) xscale yscale = do+ (LineOptions ds lw) <- asks (_lineoptions . _renderoptions)+ cairo $ formatLineSeries' ds ((lw)/(xscale+yscale)) c+formatLineSeries (TypeLine (LineOptions ds lw) c) xscale yscale = cairo $ formatLineSeries' ds ((lw)/(xscale+yscale)) c++formatPointSeries' :: Color -> C.Render ()+formatPointSeries' = setColour++formatPointSeries :: PointType -> Double -> Double -> Render (LineWidth,Glyph)+formatPointSeries (FullPoint (PointOptions pz c) g) _ _ = do+ cairo $ formatPointSeries' c+ return (pz,g)++formatBarSeries' :: LineWidth -> C.Render ()+formatBarSeries' lw = C.setLineWidth lw++formatBarSeries :: BarType -> Double -> Double -> Render (Width,Color,Color)+formatBarSeries (ColourBar c) xscale yscale = do+ let sc = (xscale+yscale)/2+ (BarOptions bw lw bc) <- asks (_baroptions . _renderoptions)+ cairo $ formatBarSeries' (lw/sc)+ return (bw/sc,c,bc)+formatBarSeries (TypeBar (BarOptions bw lw bc) c) xscale yscale = do+ let sc = (xscale+yscale)/2+ cairo $ formatBarSeries' (lw/sc)+ return (bw/sc,c,bc)++-----------------------------------------------------------------------------++renderSamples :: Double -> Double + -> Maybe (C.Render ())+ -> (Double -> Double -> C.Render ()) -> C.Render ()+ -> Vector Double -> Vector Double -> Render ()+renderSamples xmin xmax s f e t y = do+ (BoundingBox _ _ w _) <- get+ let ln = dim t+ m = isMonotoneIncreasing t+ (xmin_ix,xmax_ix,num_pts) = if m+ then (findMinIdx t xmin 0 (ln-1)+ ,findMaxIdx t xmax (ln-1) 0+ ,xmax_ix - xmin_ix + 1)+ else (0,ln-1,1)+ diff'' = (fromIntegral num_pts)/w+ diff' = round $ if diff'' <= 1 then 1 else diff''+ diff = if m then diff' else 1+ cairo $ do+ case s of+ Nothing -> C.moveTo (t @> xmin_ix) (y @> xmin_ix)+ Just s' -> s'+ _ <- runMaybeT $ mapVectorWithIndexM_ (\i y' -> do+ when (i >= xmin_ix && i `mod` diff == 0)+ (do+ renderSample i xmax_ix t f e y')+ return ()) y+ return ()++-----------------------------------------------------------------------------++renderSample :: Int -> Int -> Vector Double + -> (Double -> Double -> C.Render ()) -> C.Render () + -> Double -> MaybeT C.Render ()+renderSample ix xmax_ix t f e y+ | ix >= xmax_ix = do+ lift $ do+ f (t @> ix) y+ e+ fail "end of bounded area"+ | otherwise = do+ lift $ f (t @> ix) y++-----------------------------------------------------------------------------++renderLineSample :: Double -> Double -> C.Render ()+renderLineSample = C.lineTo++endLineSample :: C.Render ()+endLineSample = C.stroke++renderPointSample :: Double -> Double -> LineWidth -> Glyph -> Double -> Double -> C.Render ()+renderPointSample xscale yscale pz g x y = do+ C.moveTo x y+ renderGlyph xscale yscale pz g++endPointSample :: C.Render ()+endPointSample = return ()++renderImpulseSample :: Double -> Double -> C.Render ()+renderImpulseSample x y = do+ C.moveTo x 0+ C.lineTo x y+ C.stroke++endImpulseSample :: C.Render ()+endImpulseSample = return ()++renderStepSample :: Double -> Double -> C.Render ()+renderStepSample x y = do+ (x',_) <- C.getCurrentPoint+ C.lineTo x' y+ C.lineTo x y++endStepSample :: C.Render ()+endStepSample = C.stroke++renderAreaSample :: Double -> Double -> C.Render ()+renderAreaSample = C.lineTo++endAreaSample :: Double -> Double -> C.Render ()+endAreaSample x0 _ = do+ (x',_) <- C.getCurrentPoint+ C.lineTo x' 0+ C.lineTo x0 0+ -- C.lineTo x0 y0+ C.closePath+ C.fill+ C.stroke++renderBarSample :: Width -> Color -> Color -> Double -> Double -> C.Render ()+renderBarSample bw c bc x y = do+ setColour bc+ C.rectangle (x-bw/2) 0 bw y+ C.strokePreserve+ setColour c+ C.fill+ ++endBarSample :: C.Render ()+endBarSample = return ()++renderHistSample :: Width -> Color -> Color -> Double -> Double -> C.Render ()+renderHistSample bw c bc x y = do+ (x',_) <- C.getCurrentPoint+ C.stroke+ setColour bc+ C.rectangle x' 0 (x-x') y+ C.strokePreserve+ setColour c+ C.fill+ C.moveTo x 0++endHistSample :: C.Render ()+endHistSample = return ()++-----------------------------------------------------------------------------++monoStep :: Double -> MaybeT (State Double) ()+monoStep d = do+ dp <- get+ when (d < dp) (fail "negative difference")+ put d+{-# INLINE monoStep #-}++isMonotoneIncreasing :: Vector Double -> Bool+isMonotoneIncreasing v = maybe False (\_ -> True) $ evalState (runMaybeT $ (mapVectorM_ monoStep v)) (v @> 0)++-----------------------------------------------------------------------------++
+ lib/Graphics/Rendering/Plot/Render/Plot/Glyph.hs view
@@ -0,0 +1,163 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Plot.Glyph+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Plot.Glyph (+ -- * Rendering+ renderGlyph+ ) where++-----------------------------------------------------------------------------++import qualified Graphics.Rendering.Cairo as C++import Graphics.Rendering.Plot.Types++-----------------------------------------------------------------------------++glyphWidth :: Double+glyphWidth = 2*pi++renderGlyph :: Double -> Double -> LineWidth -> Glyph -> C.Render ()+renderGlyph xscale yscale pz g = do+ C.save+ C.scale (pz / xscale) (pz / yscale)+ C.setLineWidth 1+ renderGlyph' g+ C.restore+ where renderGlyph' Box = renderGlyphBox + renderGlyph' Cross = renderGlyphCross + renderGlyph' Diamond = renderGlyphDiamond + renderGlyph' Asterisk = renderGlyphAsterisk + renderGlyph' Triangle = renderGlyphTriangle + renderGlyph' Circle = renderGlyphCircle + renderGlyph' Bullet = renderGlyphBullet + renderGlyph' Top = renderGlyphTop + renderGlyph' Bot = renderGlyphBot +--renderGlyph _ _ _ = return ()++difference :: Num a => [a] -> [a]+difference [] = []+difference [_] = []+difference (x0:x1:xs) = (x1-x0):(difference (x1:xs))++renderGlyphBox :: C.Render ()+renderGlyphBox = do+ let x = glyphWidth+ y = glyphWidth+ C.relMoveTo (-x/2) (-y/2)+ C.relLineTo 0 y+ C.relLineTo x 0+ C.relLineTo 0 (-y)+ C.closePath+ C.stroke++renderGlyphCross :: C.Render ()+renderGlyphCross = do+ let x = glyphWidth+ y = glyphWidth+ C.relMoveTo (-x/2) 0+ C.relLineTo x 0+ C.relMoveTo (-x/2) (-y/2)+ C.relLineTo 0 y+ C.closePath+ C.stroke++renderGlyphDiamond :: C.Render ()+renderGlyphDiamond = do+ let x = glyphWidth+ y = glyphWidth+ C.relMoveTo (-x/2) 0+ C.relLineTo (x/2) y+ C.relLineTo (x/2) (-y)+ C.relLineTo (-x/2) (-y)+ C.closePath+ C.stroke++renderGlyphAsterisk :: C.Render ()+renderGlyphAsterisk = do+ let radius = glyphWidth/2+ angles' = map ((+ 90) . (* (360 `div` 5))) [0..4]+ angles = map ((* (2*pi/360)) . fromInteger . (`mod` 360)) angles'+ xs = map ((* (radius)) . cos) angles+ ys = map ((* (radius)) . sin) angles+ mapM_ (\(x,y) -> do+ C.relLineTo x y+ C.relMoveTo (-x) (-y)) (zip xs ys)+ C.stroke++renderGlyphTriangle :: C.Render ()+renderGlyphTriangle = do+ let radius = glyphWidth/2+ angles' = [90,210,330]+ --angles' = map ((flip (+) 90) . (* (360 `div` 3))) [0..2]+ angles = map ((* (2*pi/360)) . fromInteger . (`mod` 360)) angles'+ x@(sx:_) = map ((* (radius)) . cos) angles+ y@(sy:_) = map ((* (radius)) . sin) angles+ xs = difference x+ ys = difference y+ C.relMoveTo sx sy+ mapM_ (uncurry C.relLineTo) (zip xs ys)+ C.closePath+ C.stroke++renderGlyphCircle :: C.Render ()+renderGlyphCircle = do+ let radius = glyphWidth/2+ angles = map (*(2*pi/36)) [0..35] + x@(sx:_) = map ((* (radius)) . cos) angles+ y@(sy:_) = map ((* (radius)) . sin) angles+ xs = difference x+ ys = difference y+ C.relMoveTo sx sy+ mapM_ (uncurry C.relLineTo) (zip xs ys)+ C.closePath+ C.stroke+ +renderGlyphBullet :: C.Render ()+renderGlyphBullet = do+ let radius = glyphWidth/2+ angles = map (*(2*pi/36)) [0..35] + x@(sx:_) = map ((* (radius)) . cos) angles+ y@(sy:_) = map ((* (radius)) . sin) angles+ xs = difference x+ ys = difference y+ C.relMoveTo sx sy+ mapM_ (uncurry C.relLineTo) (zip xs ys)+ C.closePath+ C.fill+ C.stroke+ +renderGlyphTop :: C.Render ()+renderGlyphTop = do+ let x = glyphWidth+ y = glyphWidth+ C.relMoveTo (-x/2) 0+ C.relLineTo x 0+ C.relMoveTo (-x/2) 0+ C.relLineTo 0 (-y)+ C.stroke++renderGlyphBot :: C.Render ()+renderGlyphBot = do+ let x = glyphWidth+ y = glyphWidth+ C.relMoveTo (-x/2) 0+ C.relLineTo x 0+ C.relMoveTo (-x/2) 0+ C.relLineTo 0 (y)+ C.stroke++-----------------------------------------------------------------------------++
+ lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs view
@@ -0,0 +1,305 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Plot.Legend+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Plot.Legend (+ -- * Rendering+ renderLegend+ ) where++-----------------------------------------------------------------------------++import Data.List(maximumBy)++import Data.Colour.Names++import qualified Data.Array.IArray as A+import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++import Control.Monad.Reader++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults++import Graphics.Rendering.Plot.Render.Types+import Graphics.Rendering.Plot.Render.Text+import Graphics.Rendering.Plot.Render.Plot.Glyph++--import qualified Text.Printf as Printf++--import Prelude hiding(min,max)+--import qualified Prelude(max)++-----------------------------------------------------------------------------++renderLegend :: Maybe LegendData -> DataSeries -> Render (Padding -> Render ())+renderLegend Nothing _ = return $ \_ -> return ()+renderLegend (Just (Legend b l o to)) d = do+ -- calculate row height and max length+ let (ln,ls) = getLabels d+ mx = maximumBy (\ x y -> length x `compare` length y) $ fst $ unzip ls+ pc <- asks _pangocontext+ (w,h) <- cairo $ do+ lo <- pango $ P.layoutText pc mx+ setTextOptions to lo+ (_,twh) <- textSize lo Centre Middle 0 0 + return twh+ -- if outside shift bounding box+ case o of+ -- render legend+ Outside -> do+ outside <- renderLegendOutside b l w h to ln ls+ return outside+ -- else return (render legend)+ Inside -> return $ \_ -> renderLegendInside b l w h to ln ls++renderLegendOutside :: Bool -> LegendLocation -> Double -> Double -> TextOptions -> Int -> [(SeriesLabel,Decoration)] -> Render (Padding -> Render ())+renderLegendOutside b l w h to ln ls + | l == North = do+ let h' = textPad + h + textPad+ bbLowerTop $ h' + 4*textPad+ return $ \(Padding _ _ _ t) -> do+ x' <- bbCentreWidth+ y' <- bbTopHeight+ let w' = (fromIntegral ln)*(textPad + legendSampleWidth + + legendSampleWidth + textPad + w) + 5*textPad+ let x = x'- (w'/2)+ y = y'- h' - t+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')+ renderLegendEntries (x+3*textPad) (y+textPad) + (textPad + legendSampleWidth+ + legendSampleWidth + textPad + + w + textPad) 0 0 h to ls + return ()+ | l == NorthEast = do+ let h' = textPad + h + textPad+ bbLowerTop $ h' + 4*textPad+ return $ \(Padding _ _ _ t) -> do+ x' <- bbRightWidth+ y' <- bbTopHeight+ let w' = (fromIntegral ln)*(textPad + legendSampleWidth + + legendSampleWidth + textPad + w) + 5*textPad+ let x = x'- w'+ y = y'- h' - t+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')+ renderLegendEntries (x+3*textPad) (y+textPad) + (textPad + legendSampleWidth+ + legendSampleWidth + textPad + + w + textPad) 0 0 h to ls + return ()+ | l == East = do+ let w' = textPad + legendSampleWidth + + legendSampleWidth + textPad + w + textPad+ bbShiftRight $ w' + 4*textPad+ return $ \(Padding _ r _ _) -> do+ x' <- bbRightWidth+ y' <- bbCentreHeight+ let h' = (fromIntegral ln)*(h+textPad) + 5*textPad+ let x = x' + 4*textPad + r+ y = y'-(h'/2)+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')+ renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad) 0 h to ls + return ()+ | l == SouthEast = do+ let h' = textPad + h + textPad+ bbRaiseBottom $ h' + 4*textPad+ return $ \(Padding _ _ b' _) -> do+ x' <- bbRightWidth+ y' <- bbBottomHeight+ let w' = (fromIntegral ln)*(textPad + legendSampleWidth + + legendSampleWidth + textPad + w) + 5*textPad+ let x = x'- w'+ y = y' + b' +textPad+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')+ renderLegendEntries (x+3*textPad) (y+textPad) + (textPad + legendSampleWidth+ + legendSampleWidth + textPad + + w + textPad) 0 0 h to ls + return ()+ | l == South = do+ let h' = textPad + h + textPad+ bbRaiseBottom $ h' + 4*textPad+ return $ \(Padding _ _ b' _) -> do+ x' <- bbCentreWidth+ y' <- bbBottomHeight+ let w' = (fromIntegral ln)*(textPad + legendSampleWidth + + legendSampleWidth + textPad + w) + 5*textPad+ let x = x' - (w'/2)+ y = y' + b' +textPad+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')+ renderLegendEntries (x+3*textPad) (y+textPad) + (textPad + legendSampleWidth+ + legendSampleWidth + textPad + + w + textPad) 0 0 h to ls + return ()+ | l == SouthWest = do+ let h' = textPad + h + textPad+ bbRaiseBottom $ h' + 4*textPad+ return $ \(Padding _ _ b' _) -> do+ x' <- bbLeftWidth+ y' <- bbBottomHeight+ let w' = (fromIntegral ln)*(textPad + legendSampleWidth + + legendSampleWidth + textPad + w) + 5*textPad+ let x = x'+ y = y' + b' +textPad+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')+ renderLegendEntries (x+3*textPad) (y+textPad) + (textPad + legendSampleWidth+ + legendSampleWidth + textPad + + w + textPad) 0 0 h to ls + return ()+ | l == West = do+ let w' = textPad + legendSampleWidth + + legendSampleWidth + textPad + w + textPad+ bbShiftLeft $ w' + 4*textPad+ return $ \(Padding l' _ _ _) -> do+ x' <- bbLeftWidth+ y' <- bbCentreHeight+ let h' = (fromIntegral ln)*(h+textPad) + 5*textPad+ let x = x' - w' - 4*textPad - l'+ y = y'-(h'/2)+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')+ renderLegendEntries (x+2*textPad) (y+3*textPad) 0 (h+textPad) 0 h to ls + return ()+ | l == NorthWest = do+ let h' = textPad + h + textPad+ bbLowerTop $ h' + 4*textPad+ return $ \(Padding _ _ _ t) -> do+ x' <- bbLeftWidth+ y' <- bbTopHeight+ let w' = (fromIntegral ln)*(textPad + legendSampleWidth + + legendSampleWidth + textPad + w) + 5*textPad+ let x = x'+ y = y'- h' - t+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h')+ renderLegendEntries (x+3*textPad) (y+textPad) + (textPad + legendSampleWidth+ + legendSampleWidth + textPad + + w + textPad) 0 0 h to ls + return ()++renderBorder :: Double -> Color -> Double -> Double -> Double -> Double -> C.Render ()+renderBorder lw c x y w h = do+ C.setLineWidth lw+ setColour c+ C.rectangle x y w h+ C.stroke+ ++renderLegendInside :: Bool -> LegendLocation -> Double -> Double -> TextOptions -> Int -> [(SeriesLabel,Decoration)] -> Render ()+renderLegendInside b l w h to ln ls = do+ let w' = (textPad + legendSampleWidth + + legendSampleWidth + textPad + w + textPad)+ h' = h+textPad+ h'' = (fromIntegral ln)*h'+textPad+ (x,y) <- case l of+ North -> do+ x' <- bbCentreWidth+ y' <- bbTopHeight+ return (x'-w'/2-textPad,y'+textPad)+ NorthEast -> do+ x' <- bbRightWidth+ y' <- bbTopHeight+ return (x'-w'-3*textPad,y'+textPad)+ East -> do+ x' <- bbRightWidth+ y' <- bbCentreHeight+ let y'' = y' - h''/2 + return (x'-w'-3*textPad,y''-textPad)+ SouthEast -> do+ x' <- bbRightWidth+ y' <- bbBottomHeight+ let y'' = y' - h''+ return (x'-w'-3*textPad,y''-3*textPad)+ South -> do+ x' <- bbCentreWidth+ y' <- bbBottomHeight+ let y'' = y' - h''+ return (x'-w'/2-textPad,y''-3*textPad)+ SouthWest -> do+ x' <- bbLeftWidth+ y' <- bbBottomHeight+ let y'' = y' - h''+ return (x'+textPad,y''-3*textPad)+ West -> do+ x' <- bbLeftWidth+ y' <- bbCentreHeight+ let y'' = y' - h''/2 + return (x'+textPad,y''-textPad)+ NorthWest -> do+ x' <- bbLeftWidth+ y' <- bbTopHeight+ return (x'+textPad,y'+textPad)+ when b (cairo $ renderBorder 1.0 black (x+0.5) (y+0.5) w' h'')+ cairo $ do+ --C.setSourceRGBA 1 0 0 0+ setColour white+ C.rectangle (x+0.5) (y+0.5) w' h''+ C.fill+ C.stroke+ renderLegendEntries (x+3*textPad) (y+textPad) 0 h' w' (h'-textPad) to ls ++renderLegendEntries :: Double -> Double -> Double -> Double -> Double -> Double + -> TextOptions+ -> [(SeriesLabel,Decoration)] -> Render ()+renderLegendEntries x y wa ha w h to ls = do+ _ <- foldM (renderLegendEntry wa ha w h to) (x,y) ls+ return ()++renderLegendEntry :: Double -> Double -> Double -> Double -> TextOptions -> (Double,Double) -> (SeriesLabel,Decoration) -> Render (Double,Double)+renderLegendEntry wa ha _ h to (x,y) (l,d) = do+ renderLegendSample x y legendSampleWidth h d+ pc <- asks _pangocontext+ cairo $ do+ lo <- pango $ P.layoutText pc l+ setTextOptions to lo+ showText lo (x+legendSampleWidth + 2*textPad) y+ return (x+wa,y+ha)++renderLegendSample :: Double -> Double -> Double -> Double -> Decoration -> Render ()+renderLegendSample x y w h d = do+ let l = decorationGetLineType d+ let p = decorationGetPointType d+ case l of+ Nothing -> return ()+ Just l' -> do+ cairo $ do+ setLineStyle l'+ C.moveTo x (y+h/2+0.5)+ C.lineTo (x+w) (y+h/2+0.5)+ C.stroke+ case p of+ Nothing -> return ()+ Just p' -> do+ cairo $ do+ g <- setPointStyle p'+ C.moveTo (x+w/2) (y+h/2)+ renderGlyph 1 1 1 g++-----------------------------------------------------------------------------++getLabels :: DataSeries -> (Int,[(SeriesLabel,Decoration)])+getLabels (DS_Y d) = let mls = map (\(DecSeries o d') -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d+ ln = length mls+ in (ln,mls)+getLabels (DS_1toN _ d) = let mls = map (\(DecSeries o d') -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d+ ln = length mls+ in (ln,mls)+getLabels (DS_1to1 d) = let mls = map (\(_,(DecSeries o d')) -> (maybe "" id $ getOrdLabel o,d')) $ A.elems d+ ln = length mls+ in (ln,mls)+getLabels (DS_Surf _) = (0,[])++-----------------------------------------------------------------------------+
+ lib/Graphics/Rendering/Plot/Render/Text.hs view
@@ -0,0 +1,151 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Text+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Text (+ -- * Rendering+ renderText+ , renderTextVertical+ -- * Internal+ , textSize+ , textSizeVertical+ , showText+ , formatText+ ) where++-----------------------------------------------------------------------------++--import Data.Either++--import Data.Packed.Vector+--import Numeric.LinearAlgebra.Linear++--import Data.Word++--import Data.Maybe++--import Data.Colour.SRGB+--import Data.Colour.Names++---import qualified Data.Array.IArray as A++import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++import Control.Monad.Reader+--import Control.Monad.State+--import Control.Monad.Trans++import Graphics.Rendering.Plot.Types+--import Graphics.Rendering.Plot.Defaults++import Graphics.Rendering.Plot.Figure.Text++import Graphics.Rendering.Plot.Render.Types++--import qualified Text.Printf as Printf++--import Prelude hiding(min,max)+--import qualified Prelude(max)++-----------------------------------------------------------------------------++textSize :: P.PangoLayout -> TextXAlign -> TextYAlign -> Double -> Double -> C.Render ((Double,Double),(Double,Double))+textSize l xa ya x y = do+ (_,P.PangoRectangle _ _ w h) <- pango $ P.layoutGetExtents l+ return ((xStart xa x w h,yStart ya y w h),(w,h))+ where xStart TLeft x' w' _ = x' - w'+ xStart Centre x' w' _ = x' - (w'/2)+ xStart TRight x' _ _ = x'+ yStart TBottom y' _ h' = y' - h'+ yStart Middle y' _ h' = y' - (h'/2)+ yStart TTop y' _ _ = y'++textSizeVertical :: P.PangoLayout -> TextXAlign -> TextYAlign -> Double -> Double -> C.Render ((Double,Double),(Double,Double))+textSizeVertical l xa ya x y = do+ (_,P.PangoRectangle _ _ w h) <- pango $ P.layoutGetExtents l+ return ((xStart xa x w h,yStart ya y w h),(w,h))+ where xStart TLeft x' _ w' = x' - w'+ xStart Centre x' _ w' = x' - (w'/2)+ xStart TRight x' _ _ = x'+ yStart TBottom y' _ _ = y'+ yStart Middle y' h' _ = y' + (h'/2)+ yStart TTop y' h' _ = y' + (h')++showText :: P.PangoLayout -> Double -> Double -> C.Render ()+showText pl x y = do+ C.moveTo x y+ P.showLayout pl++-----------------------------------------------------------------------------++formatText :: TextEntry -> Render TextEntry+formatText te@NoText = return te+formatText (BareText s) = do+ to <- asks (_textoptions . _renderoptions)+ return (FontText to s)+formatText (SizeText fz c s) = do+ to <- asks (_textoptions . _renderoptions)+ return $ (FontText (changeFontSize fz $ changeFontColour c to) s)+formatText te@(FontText _ _) = return te ++{-+getTextSize :: Text -> Render (Double,Double)+getTextSize (Text Nothing s) = do+ to <- asks _text+ getTextSize (Text to s)+getTextSize (Text (Just (TextOptions (FontOptions ff fs fw) fz _)) s) = cairo $ do+ C.selectFontFace ff fs fw+ C.setFontSize fz+ te <- C.textExtents s+ return (C.textExtentsWidth te,C.textExtentsHeight te)+-}+renderText :: TextEntry -> TextXAlign -> TextYAlign -> Double -> Double -> Render (Double,Double)+renderText NoText _ _ _ _ = return (0,0)+renderText te@(BareText _) xa ya x y = do+ te' <- formatText te+ renderText te' xa ya x y+renderText te@(SizeText _ _ _) xa ya x y = do+ te' <- formatText te+ renderText te' xa ya x y+renderText (FontText to s) xa ya x y = do+ pc <- asks _pangocontext+ cairo $ do+ lo <- pango $ P.layoutText pc s+ setTextOptions to lo+ ((x',y'),twh) <- textSize lo xa ya x y + showText lo x' y'+ return twh++renderTextVertical :: TextEntry -> TextXAlign -> TextYAlign -> Double -> Double -> Render (Double,Double)+renderTextVertical NoText _ _ _ _ = return (0,0)+renderTextVertical te@(BareText _) xa ya x y = do+ te' <- formatText te+ renderTextVertical te' xa ya x y+renderTextVertical te@(SizeText _ _ _) xa ya x y = do+ te' <- formatText te+ renderTextVertical te' xa ya x y+renderTextVertical (FontText to s) xa ya x y = do+ pc <- asks _pangocontext+ cairo $ do+ lo <- pango $ P.layoutText pc s+ setTextOptions to lo+ C.save+ C.rotate (-pi/2)+ P.updateLayout lo+ ((x',y'),twh) <- textSizeVertical lo xa ya x y + showText lo (-y') (x')+ C.restore+ return twh+ +-----------------------------------------------------------------------------
+ lib/Graphics/Rendering/Plot/Render/Types.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Types+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Types where++-----------------------------------------------------------------------------++--import Data.Either++--import Data.Packed.Vector+--import Numeric.LinearAlgebra.Linear++--import Data.Word++import Data.Maybe++import Data.Colour.SRGB+import Data.Colour.Names++--import qualified Data.Array.IArray as A++import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Pango as P++import Control.Monad.Reader+import Control.Monad.State+--import Control.Monad.Trans++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults++--import Graphics.Rendering.Plot.Figure.Text++--import qualified Text.Printf as Printf++--import Prelude hiding(min,max)+--import qualified Prelude(max)++-----------------------------------------------------------------------------+{-+newtype Render a = FR { runRender :: StateT BoundingBox C.Render a }+ deriving(Monad, MonadState BoundingBox, MonadTrans (StateT BoundingBox))+-}++data RenderEnv = RenderEnv {+ _pangocontext :: P.PangoContext+ , _renderoptions :: Options+ }++newtype BoundedT m a = BT { runRender :: ReaderT RenderEnv (StateT BoundingBox m) a }+ deriving(Monad, MonadState BoundingBox, MonadReader RenderEnv)++instance MonadTrans BoundedT where+ lift m = BT $ lift $ lift m++type Render = BoundedT C.Render++evalRender :: Render a -> RenderEnv -> BoundingBox -> C.Render a+evalRender m r = evalStateT (runReaderT (runRender m) r)++-----------------------------------------------------------------------------++cairo :: C.Render a -> Render a+cairo = lift++pango :: IO a -> C.Render a+pango = liftIO++-----------------------------------------------------------------------------++bbX, bbY, bbW, bbH :: Render Double+bbX = gets _bbX+bbY = gets _bbY+bbW = gets _bbW+bbH = gets _bbH+ +bbLeftWidth, bbCentreWidth, bbRightWidth, bbBottomHeight, bbCentreHeight, bbTopHeight :: Render Double+bbLeftWidth = gets $ \(BoundingBox x _ _ _) -> x+bbCentreWidth = gets $ \(BoundingBox x _ w _) -> x + w / 2+bbRightWidth = gets $ \(BoundingBox x _ w _) -> x + w+bbBottomHeight = gets $ \(BoundingBox _ y _ h) -> y + h+bbCentreHeight = gets $ \(BoundingBox _ y _ h) -> y + h / 2+bbTopHeight = gets $ \(BoundingBox _ y _ _) -> y++bbShiftLeft, bbShiftRight, bbLowerTop, bbRaiseBottom :: Double -> Render ()+bbShiftLeft n = modify $ \(BoundingBox x y w h) -> BoundingBox (x+n) y (w-n) h+bbShiftRight n = modify $ \(BoundingBox x y w h) -> BoundingBox x y (w-n) h+bbLowerTop n = modify $ \(BoundingBox x y w h) -> BoundingBox x (y+n) w (h-n)+bbRaiseBottom n = modify $ \(BoundingBox x y w h) -> BoundingBox x y w (h-n)++applyPads :: Padding -> Render ()+applyPads (Padding l r b t) = modify (\(BoundingBox x y w h) -> BoundingBox (x+l) (y+t) (w-l-r) (h-t-b))++-----------------------------------------------------------------------------++clipBoundary :: Render ()+clipBoundary = do+ (BoundingBox x y w h) <- get+ cairo $ do+ C.rectangle x y w h+ C.clip++-----------------------------------------------------------------------------++-- | output file type+data OutputType = PNG | PS | PDF | SVG++-----------------------------------------------------------------------------++setColour :: Color -> C.Render ()+setColour c = let (RGB r g b) = toSRGB c+ in C.setSourceRGBA r g b 1 -- no transparent colours+++setDashes :: [Dash] -> C.Render ()+setDashes [] = C.setDash [] 0+setDashes xs = do+ let xs' = concat $ map (\d -> case d of { Dot -> [1,1] ; Dash -> [2,1] }) xs+ C.setDash xs' 0+ +-----------------------------------------------------------------------------++getDefaultTextOptions :: P.PangoContext -> IO TextOptions+getDefaultTextOptions pc = do+ fd <- P.contextGetFontDescription pc+ getTextOptionsFD fd++getTextOptionsFD :: P.FontDescription -> IO TextOptions+getTextOptionsFD fd = do+ ff' <- P.fontDescriptionGetFamily fd+ fs' <- P.fontDescriptionGetStyle fd+ fv' <- P.fontDescriptionGetVariant fd+ fw' <- P.fontDescriptionGetWeight fd+ fc' <- P.fontDescriptionGetStretch fd+ fz' <- P.fontDescriptionGetSize fd+ let ff = fromMaybe defaultFontFamily ff'+ fs = fromMaybe defaultFontStyle fs'+ fv = fromMaybe defaultFontVariant fv'+ fw = fromMaybe defaultFontWeight fw'+ fc = fromMaybe defaultFontStretch fc'+ fz = fromMaybe defaultFontSize fz'+ return $ TextOptions (FontOptions ff fs fv fw fc) fz black++setTextOptions :: TextOptions -> P.PangoLayout -> C.Render ()+setTextOptions to lo = do+ fd' <- pango $ P.layoutGetFontDescription lo+ fd <- case fd' of+ Nothing -> pango $ P.fontDescriptionNew+ Just fd'' -> return fd''+ setTextOptionsFD to fd+ pango $ P.layoutSetFontDescription lo (Just fd)++setTextOptionsFD :: TextOptions -> P.FontDescription -> C.Render ()+setTextOptionsFD (TextOptions (FontOptions ff fs fv fw fc) fz c) fd = do+ pango $ do+ P.fontDescriptionSetFamily fd ff+ P.fontDescriptionSetStyle fd fs+ P.fontDescriptionSetVariant fd fv+ P.fontDescriptionSetWeight fd fw+ P.fontDescriptionSetStretch fd fc+ P.fontDescriptionSetSize fd fz+ setColour c++-----------------------------------------------------------------------------++textPad :: Double+textPad = 2++data TextXAlign = TLeft | Centre | TRight+data TextYAlign = TBottom | Middle | TTop++-----------------------------------------------------------------------------++setLineOptions :: LineOptions -> C.Render ()+setLineOptions (LineOptions ds lw) = do+ setDashes ds+ C.setLineWidth lw++setLineStyle :: LineType -> C.Render ()+setLineStyle NoLine = return ()+setLineStyle (ColourLine c) = setColour c+setLineStyle (TypeLine lo c) = do+ setLineOptions lo+ setColour c++-----------------------------------------------------------------------------++setPointOptions :: PointOptions -> C.Render ()+setPointOptions (PointOptions pz c) = do+ setColour c+ C.scale pz pz++setPointStyle :: PointType -> C.Render Glyph+setPointStyle (FullPoint po g) = do+ setPointOptions po+ return g++-----------------------------------------------------------------------------+++
+ lib/Graphics/Rendering/Plot/Types.hs view
@@ -0,0 +1,465 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UnicodeSyntax #-}+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Types+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Types+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Types where++-----------------------------------------------------------------------------++import Data.Packed.Vector+import Data.Packed.Matrix++import Data.Colour.SRGB+import Data.Colour()++import qualified Data.Array.IArray as A++import qualified Graphics.Rendering.Pango as P++import Control.Monad.State+import Control.Monad.Reader++import Control.Monad.Supply++-----------------------------------------------------------------------------+-----------------------------------------------------------------------------+-----------------------------------------------------------------------------++type Color = Colour Double++-----------------------------------------------------------------------------++-- x,y,w,h+data BoundingBox = BoundingBox { _bbX :: Double, _bbY :: Double+ , _bbW :: Double, _bbH :: Double }++-----------------------------------------------------------------------------++type FontFamily = String+type FontSize = Double+data FontOptions = FontOptions FontFamily P.FontStyle P.Variant P.Weight P.Stretch+data TextOptions = TextOptions FontOptions FontSize Color+data TextEntry = NoText + | BareText String+ | SizeText FontSize Color String+ | FontText TextOptions String++-----------------------------------------------------------------------------++newtype Text a = FT { runText :: ReaderT TextOptions (State TextEntry) a}+ deriving(Monad, MonadReader TextOptions, MonadState TextEntry)++execText :: Text a -> TextOptions -> TextEntry -> TextEntry+execText m r = execState (runReaderT (runText m) r) ++-----------------------------------------------------------------------------++type Solid = Bool++type PointSize = Double+data Glyph = Box | Cross | Diamond | Asterisk | Triangle | Circle | Bullet | Top | Bot+--data GlyphType = Glyph Glyph Solid +data PointOptions = PointOptions PointSize Color+data PointType = FullPoint PointOptions Glyph++-----------------------------------------------------------------------------++newtype Point a = FG { runPoint :: ReaderT PointOptions (State PointType) a}+ deriving(Monad, MonadReader PointOptions, MonadState PointType)++execPoint :: Point a -> PointOptions -> PointType -> PointType+execPoint m r = execState (runReaderT (runPoint m) r)++-----------------------------------------------------------------------------++data Dash = Dot | Dash+type DashStyle = [Dash]+type LineWidth = Double+-- not using line join+-- not using line cap+-- do we want arrows?+data LineOptions = LineOptions DashStyle LineWidth++data LineType = NoLine+ | ColourLine Color+ | TypeLine LineOptions Color++-----------------------------------------------------------------------------++newtype Line a = FL { runLine :: ReaderT LineOptions (State LineType) a}+ deriving(Monad, MonadReader LineOptions, MonadState LineType)++execLine :: Line a -> LineOptions -> LineType -> LineType+execLine m r = execState (runReaderT (runLine m) r) ++-----------------------------------------------------------------------------++type Width = Double+data BarOptions = BarOptions Width LineWidth Color++data BarType = ColourBar Color+ | TypeBar BarOptions Color++-----------------------------------------------------------------------------++newtype Bar a = FB { runBar :: ReaderT BarOptions (State BarType) a}+ deriving(Monad, MonadReader BarOptions, MonadState BarType)++execBar :: Bar a -> BarOptions -> BarType -> BarType+execBar m r = execState (runReaderT (runBar m) r) ++-----------------------------------------------------------------------------++type Length = Double+type Location = (Double,Double)+type Orientation = Double -- angle+type Arrow = Bool++-- extra glyphs and so on that can be put in a chart+data AnnoteType = AT_Text TextEntry+ | AT_Glyph Glyph+ | AT_Arrow Arrow LineOptions Length++data Annotation = Annotation AnnoteType Location Orientation Color+type Annotations = [Annotation]++-----------------------------------------------------------------------------++data Scale = Linear | Log deriving(Eq)++data Range = Range { _range_scale ∷ Scale, _range_min :: Double, _range_max :: Double }++data Ranges = Ranges (Either Range (Range,Range)) (Either Range (Range,Range))++getRanges :: AxisType -> AxisSide -> Ranges -> (Scale,Double,Double)+getRanges XAxis Lower (Ranges (Left (Range scale xmin xmax)) _) = (scale,xmin,xmax)+getRanges XAxis Lower (Ranges (Right (Range scale xmin xmax,_)) _) = (scale,xmin,xmax)+getRanges XAxis Upper (Ranges (Right (_,Range scale xmin xmax)) _) = (scale,xmin,xmax)+getRanges XAxis Upper (Ranges (Left _) _) = error "no upper range defined"+getRanges YAxis Lower (Ranges _ (Left (Range scale ymin ymax))) = (scale,ymin,ymax)+getRanges YAxis Lower (Ranges _ (Right (Range scale ymin ymax,_))) = (scale,ymin,ymax)+getRanges YAxis Upper (Ranges _ (Right (_,Range scale ymin ymax))) = (scale,ymin,ymax)+getRanges YAxis Upper (Ranges _ (Left _)) = error "no upper range defined"++-----------------------------------------------------------------------------++data AxisType = XAxis | YAxis deriving(Eq)+data AxisSide = Lower | Upper deriving(Eq)+data AxisPosn = Side AxisSide+ | Value Double + deriving(Eq)++data Tick = Minor | Major deriving(Eq)++type GridLines = Bool+type TickValues = Either Int (Vector Double) -- ^ Either (number of ticks) (tick values)+data Ticks = Ticks GridLines TickValues++setTickGridlines :: GridLines -> Ticks -> Ticks+setTickGridlines gl (Ticks _ tv) = Ticks gl tv++setTickValues :: TickValues -> Ticks -> Ticks+setTickValues tv (Ticks gl _) = Ticks gl tv++type TickFormat = String++data AxisData = Axis {+ _axis_type :: AxisType+ , _position :: AxisPosn+ , _line_type :: LineType+ , _minor_ticks :: Ticks+ , _major_ticks :: Ticks+ , _tick_format :: TickFormat+ , _label :: TextEntry+ }+-- want line styles, so that, e.g., axes in centre of chart are grey or dashed etc.++-----------------------------------------------------------------------------++newtype Axis a = FA { runAxis :: ReaderT Options (State AxisData) a}+ deriving(Monad, MonadReader Options, MonadState AxisData)++execAxis :: Axis a -> Options -> AxisData -> AxisData+execAxis m r = execState (runReaderT (runAxis m) r) ++-----------------------------------------------------------------------------++type LegendBorder = Bool++data LegendLocation = North | NorthEast | East | SouthEast | South + | SouthWest | West | NorthWest+ deriving(Eq)+data LegendOrientation = Inside | Outside++-- need to have same number of entries as data series+data LegendData = Legend {+ _bounded :: Bool -- is there a box around the legend?+ , _location :: LegendLocation+ , _orient :: LegendOrientation+ , _leg_fmt :: TextOptions+ }+-- do we want a toggle for legends so the labels don't get destroyed?++-----------------------------------------------------------------------------++newtype Legend a = FE { runLegend :: ReaderT TextOptions (State (Maybe LegendData)) a}+ deriving(Monad, MonadReader TextOptions, MonadState (Maybe LegendData))++execLegend :: Legend a -> TextOptions -> (Maybe LegendData) -> (Maybe LegendData)+execLegend m r = execState (runReaderT (runLegend m) r) ++-----------------------------------------------------------------------------++-- simply padding for left, right, bottom, and top+data Padding = Padding Double Double Double Double++-----------------------------------------------------------------------------++data Options = Options {+ _lineoptions :: LineOptions+ , _pointoptions :: PointOptions + , _baroptions :: BarOptions+ , _textoptions :: TextOptions+ }++-----------------------------------------------------------------------------++data SeriesType = Line | Point | LinePoint | Impulse | Step | Area | Bar | Hist++-----------------------------------------------------------------------------++type Series = Vector Double+type Surface = Matrix Double+type ErrorSeries = Series+type Function = (Double -> Double)++type SeriesLabel = String++--instance Show Function where show _ = "<<function>>"++data OrdSeries = Plain Series+ | Error Series (ErrorSeries,ErrorSeries)++getOrdData :: OrdSeries -> Series+getOrdData (Plain o) = o+getOrdData (Error o _) = o++data Abscissae = AbsFunction + | AbsPoints Series++data Ordinates = OrdFunction AxisSide Function (Maybe SeriesLabel)+ | OrdPoints AxisSide OrdSeries (Maybe SeriesLabel)++getOrdLabel :: Ordinates -> (Maybe SeriesLabel)+getOrdLabel (OrdFunction _ _ sl) = sl+getOrdLabel (OrdPoints _ _ sl) = sl++isLower :: Ordinates -> Bool+isLower (OrdFunction Lower _ _) = True+isLower (OrdPoints Lower _ _) = True+isLower _ = False++isUpper :: Ordinates -> Bool+isUpper = not . isLower++data Decoration = DecLine LineType+ | DecPoint PointType+ | DecLinPt LineType PointType+ | DecImpulse LineType+ | DecStep LineType+ | DecArea LineType+ | DecBar BarType+ | DecHist BarType++isHist :: Decoration -> Bool+isHist (DecLine _) = False+isHist (DecPoint _) = False+isHist (DecLinPt _ _) = False+isHist (DecImpulse _) = False+isHist (DecStep _) = False+isHist (DecArea _) = False+isHist (DecBar _) = False+isHist (DecHist _) = True++decorationGetLineType :: Decoration -> Maybe LineType+decorationGetLineType (DecLine lt) = Just lt+decorationGetLineType (DecPoint _) = Nothing+decorationGetLineType (DecLinPt lt _) = Just lt+decorationGetLineType (DecImpulse lt) = Just lt+decorationGetLineType (DecStep lt) = Just lt+decorationGetLineType (DecArea lt) = Just lt+decorationGetLineType (DecBar _) = Nothing+decorationGetLineType (DecHist _) = Nothing+ +decorationGetPointType :: Decoration -> Maybe PointType+decorationGetPointType (DecLine _) = Nothing+decorationGetPointType (DecPoint pt) = Just pt+decorationGetPointType (DecLinPt _ pt) = Just pt+decorationGetPointType (DecImpulse _) = Nothing+decorationGetPointType (DecStep _) = Nothing+decorationGetPointType (DecArea _) = Nothing+decorationGetPointType (DecBar _) = Nothing+decorationGetPointType (DecHist _) = Nothing+ +decorationGetBarType :: Decoration -> Maybe BarType+decorationGetBarType (DecLine _) = Nothing+decorationGetBarType (DecPoint _) = Nothing+decorationGetBarType (DecLinPt _ _) = Nothing+decorationGetBarType (DecImpulse _) = Nothing+decorationGetBarType (DecStep _) = Nothing+decorationGetBarType (DecArea _) = Nothing+decorationGetBarType (DecBar bt) = Just bt+decorationGetBarType (DecHist bt) = Just bt+ +data DecoratedSeries = DecSeries Ordinates Decoration+-- BarSeries Abscissae Ordinates BarType++data DataSeries = DS_Y (A.Array Int DecoratedSeries)+ | DS_1toN Abscissae (A.Array Int DecoratedSeries)+ | DS_1to1 (A.Array Int (Abscissae,DecoratedSeries))+ | DS_Surf Surface++-----------------------------------------------------------------------------++newtype Data a = FD { runData :: SupplyT SupplyData (ReaderT Options (State DataSeries)) a }+ deriving(Monad, MonadSupply SupplyData, MonadReader Options, MonadState DataSeries)++execData :: Data a -> SupplyData -> Options -> DataSeries -> DataSeries+execData m r s = execState (runReaderT (runSupplyT (runData m) r) s)+ +type FormattedSeries = Data DecoratedSeries++-----------------------------------------------------------------------------++type Border = Bool++-----------------------------------------------------------------------------++data SupplyData = SupplyData {+ _colours :: [Color]+ , _glyphs :: [Glyph]+ }++instance Supply SupplyData Color where+ nextSupply (SupplyData [] _ ) = error "Empty supply"+ nextSupply (SupplyData (c:cs) gs) = (c,SupplyData cs gs)+instance Supply SupplyData Glyph where+ nextSupply (SupplyData _ []) = error "Empty supply"+ nextSupply (SupplyData cs (g:gs)) = (g,SupplyData cs gs)++-----------------------------------------------------------------------------++-- | a plot +data PlotData = Plot { + _border :: Border+ , _plot_pads :: Padding+ , _heading :: TextEntry+ , _ranges :: Ranges+ , _axes :: [AxisData]+ , _data :: DataSeries+ , _legend :: Maybe LegendData+ , _annote :: Annotations+ }++-----------------------------------------------------------------------------++type Plots = A.Array (Int,Int) (Maybe PlotData) ++-----------------------------------------------------------------------------++newtype Plot a = FP { runPlot :: SupplyT SupplyData (ReaderT Options (State PlotData)) a }+ deriving(Monad, MonadReader Options, MonadSupply SupplyData, MonadState PlotData)++execPlot :: Plot a -> SupplyData -> Options -> PlotData -> PlotData+execPlot m s r = execState (runReaderT (runSupplyT (runPlot m) s) r)+ +-----------------------------------------------------------------------------++dataInPlot' :: State DataSeries a -> State PlotData a+dataInPlot' m = State $ \s -> let (a,d') = runState m (_data s)+ in (a,s { _data = d'})++dataInPlot :: Data a -> Plot a+dataInPlot m = FP $ mapSupplyT (mapReaderT dataInPlot') (runData m)++-----------------------------------------------------------------------------++legendInPlot' :: State (Maybe LegendData) a -> State PlotData a+legendInPlot' m = State $ \s -> let l = _legend s+ (a,legend) = runState m l+ in (a,s { _legend = legend})++legendInPlot :: Legend a -> Plot a+legendInPlot m = FP $ lift $ (withReaderT _textoptions . mapReaderT legendInPlot') (runLegend m)++-----------------------------------------------------------------------------++-- | a chart has a title and contains one or more plots+data FigureData = Figure { + _fig_pads :: Padding+ , _title :: TextEntry+ , _subtitle :: TextEntry+ , _plots :: Plots+ }++-----------------------------------------------------------------------------++data FigureState = FigureState {+ _defaults :: Options+ , _supplies :: SupplyData+ , _figure :: FigureData+ }++newtype Figure a = FC { runFigure :: State FigureState a }+ deriving(Monad, MonadState FigureState)++-----------------------------------------------------------------------------++execFigure :: Figure a -> FigureState -> FigureState +execFigure g = execState (runFigure g)+ +getFigure :: Figure FigureData+getFigure = gets _figure++getDefaults :: Figure Options+getDefaults = gets _defaults ++getSupplies :: Figure SupplyData+getSupplies = gets _supplies++putFigure :: FigureData -> Figure ()+putFigure p = modify $ \s -> s { _figure = p }++putDefaults :: Options -> Figure ()+putDefaults p = modify $ \s -> s { _defaults = p }++putSupplies :: SupplyData -> Figure ()+putSupplies p = modify $ \s -> s { _supplies = p }++modifyFigure :: (FigureData -> FigureData) -> Figure ()+modifyFigure m = modify $ \s -> s { _figure = m (_figure s) }++modifyDefaults :: (Options -> Options) -> Figure ()+modifyDefaults m = modify $ \s -> s { _defaults = m (_defaults s) }++-----------------------------------------------------------------------------+{-TODO+ * eeglab-like data offset in channels up x-axis+-}+-----------------------------------------------------------------------------
+ plot.cabal view
@@ -0,0 +1,94 @@+Name: plot+Version: 0.1+License: BSD3+License-file: LICENSE+Copyright: (c) A.V.H. McPhail 2010+Author: Vivian McPhail+Maintainer: haskell.vivian.mcphail <at> gmail <dot> com+Stability: experimental+Homepage: http://code.haskell.org/plot+Synopsis: A plotting library, exportable as eps/pdf/svg/png or renderable with gtk+Description: + A package for creating plots, built on top of the Cairo rendering engine. + .+ An ambitious attempt to replace gnuplot.+ .+ Monadic actions are used to configure a figure, which is a (rxc) array of subplots.+ Each plot displays a graph with optional heading, labels, legend, and annotations.+ The annotations themselves may be used to draw diagrams.+ .+ A figure is preprocessed in preparation for rendering by the Cairo renderer.+ The Cairo library can be used to output the figure to PS, PDF, SVG, and PNG file formats,+ or to display the figure in a GTK Drawable context. (see package 'plot-gtk').+ .+ The preprocessed figure can be embedded as an arbitrary Cairo render, including in a diagram+ created with the diagram package. Conversely, arbitrary Cairo renders can be embedded in+ the data region of a 'Figure'.+ .+ The data series are type "Data.Packed.Vector" from hmatrix, which, when hmatrix+ is compiled with '-fvector', is a synonym for "Data.Vector.Storable" from the+ vector package and are thus compatible with packages such as statistics.+ .+ The example in Graphics.Rendering.Plot can be viewed at + <http://code.haskell.org/plot/examples/perturbed-sine.png>++Category: Graphics++Tested-with: GHC==6.12.1+Cabal-version: >= 1.8+Build-type: Simple++Extra-source-files: README, CHANGES, LICENSE,+ examples/perturbed-sine.hs,+ examples/perturbed-sine.png++library++ Build-Depends: base >= 4 && < 5,+ base-unicode-symbols,+ mtl, array,+ MaybeT,+ pango >= 0.11.2 && < 0.12, cairo >= 0.11.1 && < 0.12,+ colour >= 2.2.1 && < 2.4,+ hmatrix >= 0.10++ Extensions: MultiParamTypeClasses+ GeneralizedNewtypeDeriving+ TypeSynonymInstances+ FlexibleInstances+ FlexibleContexts+ UndecidableInstances+ UnicodeSyntax++ hs-source-dirs: lib+ Exposed-Modules: Graphics.Rendering.Plot+ Graphics.Rendering.Plot.Figure+ Graphics.Rendering.Plot.Figure.Simple+ Graphics.Rendering.Plot.Render++ Other-modules: Graphics.Rendering.Plot.Types+ Graphics.Rendering.Plot.Defaults+ Graphics.Rendering.Plot.Figure.Line+ Graphics.Rendering.Plot.Figure.Point+ Graphics.Rendering.Plot.Figure.Bar+ Graphics.Rendering.Plot.Figure.Text+ Graphics.Rendering.Plot.Figure.Plot+ Graphics.Rendering.Plot.Figure.Plot.Axis+ Graphics.Rendering.Plot.Figure.Plot.Data+ Graphics.Rendering.Plot.Figure.Plot.Legend+ Graphics.Rendering.Plot.Render.Types+ Graphics.Rendering.Plot.Render.Text+ Graphics.Rendering.Plot.Render.Plot+ Graphics.Rendering.Plot.Render.Plot.Axis+ Graphics.Rendering.Plot.Render.Plot.Data+ Graphics.Rendering.Plot.Render.Plot.Legend+ Graphics.Rendering.Plot.Render.Plot.Glyph+ Control.Monad.Supply++ ghc-options: -Wall -fno-warn-unused-binds++ ghc-prof-options: -auto++ source-repository head+ type: darcs+ location: darcs get http://code.haskell.org/plot