diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,2 @@ +0.1: + * initial version diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/examples/perturbed-sine.hs b/examples/perturbed-sine.hs new file mode 100644 --- /dev/null +++ b/examples/perturbed-sine.hs @@ -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 diff --git a/examples/perturbed-sine.png b/examples/perturbed-sine.png new file mode 100644 Binary files /dev/null and b/examples/perturbed-sine.png differ diff --git a/lib/Control/Monad/Supply.hs b/lib/Control/Monad/Supply.hs new file mode 100644 --- /dev/null +++ b/lib/Control/Monad/Supply.hs @@ -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 gmail 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) + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot.hs b/lib/Graphics/Rendering/Plot.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot.hs @@ -0,0 +1,109 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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]) + +-} + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Defaults.hs b/lib/Graphics/Rendering/Plot/Defaults.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Defaults.hs @@ -0,0 +1,215 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Defaults +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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 + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Figure.hs b/lib/Graphics/Rendering/Plot/Figure.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure.hs @@ -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 gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Creation and manipulation of 'Figure's +-- +-- The same problem of leaked instances as at 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) } + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Bar.hs b/lib/Graphics/Rendering/Plot/Figure/Bar.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Bar.hs @@ -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 gmail 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 + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Line.hs b/lib/Graphics/Rendering/Plot/Figure/Line.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Line.hs @@ -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 gmail 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 + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot.hs b/lib/Graphics/Rendering/Plot/Figure/Plot.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Plot.hs @@ -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 gmail 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)) + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs b/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Plot/Axis.hs @@ -0,0 +1,82 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Plot.Axis +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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) } + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs b/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs @@ -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 gmail 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 + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot/Legend.hs b/lib/Graphics/Rendering/Plot/Figure/Plot/Legend.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Plot/Legend.hs @@ -0,0 +1,58 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Plot.Legend +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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 } + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Figure/Point.hs b/lib/Graphics/Rendering/Plot/Figure/Point.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Point.hs @@ -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 gmail 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? +-} + + diff --git a/lib/Graphics/Rendering/Plot/Figure/Simple.hs b/lib/Graphics/Rendering/Plot/Figure/Simple.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Simple.hs @@ -0,0 +1,152 @@ +{-# LANGUAGE UnicodeSyntax #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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 + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Figure/Text.hs b/lib/Graphics/Rendering/Plot/Figure/Text.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Figure/Text.hs @@ -0,0 +1,181 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Figure.Text +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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 + +----------------------------------------------------------------------------- + + diff --git a/lib/Graphics/Rendering/Plot/Render.hs b/lib/Graphics/Rendering/Plot/Render.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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 + diff --git a/lib/Graphics/Rendering/Plot/Render/Plot.hs b/lib/Graphics/Rendering/Plot/Render/Plot.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Plot.hs @@ -0,0 +1,129 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Plot +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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 () + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs @@ -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 gmail 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 + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs @@ -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 gmail 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) + +----------------------------------------------------------------------------- + + diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Glyph.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Glyph.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Glyph.hs @@ -0,0 +1,163 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Plot.Glyph +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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 + +----------------------------------------------------------------------------- + + diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Legend.hs @@ -0,0 +1,305 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Plot.Legend +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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,[]) + +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/Render/Text.hs b/lib/Graphics/Rendering/Plot/Render/Text.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Text.hs @@ -0,0 +1,151 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Render.Text +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail 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 + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Render/Types.hs b/lib/Graphics/Rendering/Plot/Render/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Render/Types.hs @@ -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 gmail 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 + +----------------------------------------------------------------------------- + + + diff --git a/lib/Graphics/Rendering/Plot/Types.hs b/lib/Graphics/Rendering/Plot/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Types.hs @@ -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 gmail 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 _ = "<>" + +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 +-} +----------------------------------------------------------------------------- diff --git a/plot.cabal b/plot.cabal new file mode 100644 --- /dev/null +++ b/plot.cabal @@ -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 gmail 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 + + +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