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,4 @@ +HOWTO + +cabal install plot-gtk + 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/lib/Graphics/Rendering/Plot/Gtk.hs b/lib/Graphics/Rendering/Plot/Gtk.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/Gtk.hs @@ -0,0 +1,213 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.Gtk +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Enables the display of 'Figure's interactively through GHCi +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.Gtk ( + -- * Interface + PlotHandle() + , display + , withPlotHandle + , writePlotHandle + -- * Example + -- $example + ) where + +----------------------------------------------------------------------------- + +import Control.Monad.Trans + +import Control.Concurrent + +import Graphics.UI.Gtk + +import Graphics.UI.Gtk.Plot + +import Graphics.Rendering.Plot + +----------------------------------------------------------------------------- + +data PlotHandle = PH FigureHandle (MVar DrawingArea) + +----------------------------------------------------------------------------- + +-- | create a new figure and display the plot +-- click on the window to save +display :: Figure () -> IO PlotHandle +display f = do + fs <- newFigureState f + fig <- newMVar fs + handle <- newEmptyMVar :: IO (MVar DrawingArea) + _ <- forkOS $ runInBoundThread $ do + _ <- initGUI -- is start + -- + window <- windowNew + set window [ windowTitle := "Figure" + , windowDefaultWidth := 400 + , windowDefaultHeight := 300 + , containerBorderWidth := 1 + ] + -- + frame <- frameNew + containerAdd window frame + canvas <- plotNew fig + containerAdd frame canvas + -- + putMVar handle canvas + -- + _ <- on canvas buttonPressEvent $ tryEvent $ liftIO $ do + fc <- newPlotSaveDialog + widgetShow fc + rsp <- dialogRun fc + case rsp of + ResponseAccept -> do + Just fn <- fileChooserGetFilename fc + Just ff <- fileChooserGetFilter fc + ffn <- fileFilterGetName ff + let ot = filterNameType ffn + s <- widgetGetSize canvas + fig <- get canvas figure + writeFigureState ot fn s fig + ResponseCancel -> return () + widgetHide fc + + widgetShowAll window + -- + _ <- onDestroy window mainQuit + -- + mainGUI + return $ PH fig handle + + +----------------------------------------------------------------------------- + +-- | perform some actions on the supplied 'PlotHandle' +withPlotHandle :: PlotHandle -> Figure () -> IO () +withPlotHandle (PH fm cm) fig = do + modifyMVar_ fm $ \f -> return (updateFigureState f fig) + postGUIAsync $ withMVar cm (\canvas -> do + (w,h) <- widgetGetSize canvas + widgetQueueDrawArea canvas 0 0 w h) + +-- | write the 'Figure' to disk +writePlotHandle :: PlotHandle -> OutputType -> FilePath -> (Int,Int) -> IO () +writePlotHandle (PH fm _cm) ty fn s = do + fig <- readMVar fm + writeFigureState ty fn s fig + +----------------------------------------------------------------------------- + +newPlotSaveDialog :: IO FileChooserDialog +newPlotSaveDialog = do + fc <- fileChooserDialogNew (Just "Save figure") Nothing + FileChooserActionSave + [("Accept",ResponseAccept),("Cancel",ResponseCancel)] + fileChooserSetDoOverwriteConfirmation fc True + ff_png <- fileFilterNew + fileFilterSetName ff_png "PNG" + fileFilterAddPattern ff_png "*.png" + fileChooserAddFilter fc ff_png + ff_ps <- fileFilterNew + fileFilterSetName ff_ps "PS" + fileFilterAddPattern ff_ps "*.ps" + fileChooserAddFilter fc ff_ps + ff_pdf <- fileFilterNew + fileFilterSetName ff_pdf "PDF" + fileFilterAddPattern ff_pdf "*.pdf" + fileChooserAddFilter fc ff_pdf + ff_svg <- fileFilterNew + fileFilterSetName ff_svg "SVG" + fileFilterAddPattern ff_png "*.svg" + fileChooserAddFilter fc ff_svg + return fc + +----------------------------------------------------------------------------- + +filterNameType :: String -> OutputType +filterNameType "PNG" = PNG +filterNameType "PS" = PS +filterNameType "PDF" = PDF +filterNameType "SVG" = SVG + +----------------------------------------------------------------------------- + +{- $example + +We can create a figure: + +> import Data.Colour.Names +> +> import qualified Data.Array.IArray as A +> +> import Numeric.Vector +> import Numeric.Matrix +> +> import Numeric.GSL.Statistics +> +> import Graphics.Rendering.Plot +> import Graphics.Rendering.Plot.Gtk +> +> 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*) +> +> ms :: Matrix Double +> ms = buildMatrix 64 64 (\(x,y) -> sin (2*2*pi*(fromIntegral x)/64) * cos (5*2*pi*(fromIntegral y)/64)) +> +> 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 2 +> withPlot (1,1) $ do +> setDataset (ts,[point (ds,es,"Sampled data") (Bullet,green) +> ,line (fs,"15 Hz sinusoid") blue]) +> addAxis XAxis (Side Lower) $ do +> setGridlines Major True +> withAxisLabel $ setText "time (s)" +> addAxis YAxis (Side Lower) $ do +> setGridlines Major True +> withAxisLabel $ setText "amplitude" +> addAxis XAxis (Value 0) $ return () +> setRangeFromData XAxis Lower +> setRange YAxis Lower (-1.25) 1.25 +> setLegend True NorthEast Inside +> withLegendFormat $ setFontSize 6 + +observe the results: + +>>> figure1 <- display figure + +and then update the figure + +>>> withPlotHandle figure1 $ withPlot (1,2) $ setDataset ms + +and update again + +>>> withPlotHandle figure1 $ withPlot (1,2) $ do { addAxis XAxis (Side Lower) $ setTickLabelFormat "%.0f" } +>>> let withfig1_12 = \d -> withPlotHandle figure1 $ withPlot (1,2) d +>>> withfig1_12 $ addAxis YAxis (Side Lower) $ setTickLabelFormat "%.0f" +>>> withfig1_12 $ setRangeFromData XAxis Lower +>>> withfig1_12 $ setRangeFromData YAxis Lower + +-} +----------------------------------------------------------------------------- + diff --git a/lib/Graphics/Rendering/Plot/HMatrix.hs b/lib/Graphics/Rendering/Plot/HMatrix.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/Rendering/Plot/HMatrix.hs @@ -0,0 +1,245 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.Plot.HMatrix +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- Compatability module to replace "Graphics.Plot" of the 'hmatrix' module +-- +-- Provides all functions from hmatrix's "Graphics.Plot" as well as +-- those functions appended with 'H' which return a 'PlotHandle' for +-- interactive update. +-- +----------------------------------------------------------------------------- + +module Graphics.Rendering.Plot.HMatrix ( + -- * Plotting functions + mplot, mplotH + , plot, plotH + , parametricPlot, parametricPlotH + , imshow, greyscaleH + , meshdom + -- * Compatability + , matrixToPGM + -- * Gnuplot functions + , splot, mesh + ) where + +----------------------------------------------------------------------------- +{- Function signatures copied from hmatrix, (c) A. Ruiz -} + +import Numeric.LinearAlgebra + +{- COMPATABILITY -} +import Data.List(intersperse) +import System.Process (system) + +import Graphics.Rendering.Plot.Figure + +import qualified Graphics.Rendering.Plot.Figure.Simple as S + +import Graphics.Rendering.Plot.Gtk + +----------------------------------------------------------------------------- + +nohandle m = m >> return () + +----------------------------------------------------------------------------- + +-- | plot several vectors against the first +mplot :: [Vector Double] -> IO () +mplot = nohandle . mplotH + +-- | plot several vectors against the first +mplotH :: [Vector Double] -> IO PlotHandle +mplotH [] = error "mplot': no data" +mplotH [_] = error "mplot': no ordinates" +mplotH (v:vs) = display $ S.plot (Line,v,vs) + +----------------------------------------------------------------------------- + +-- apply several functions to one object +mapf fs x = map ($ x) fs + +{- | Draws a list of functions over a desired range and with a desired number of points + +> > plot [sin, cos, sin.(3*)] (0,2*pi) 1000 + +-} +plot :: [Vector Double -> Vector Double] -> (Double,Double) -> Int -> IO () +plot fs r n = nohandle $ plotH fs r n + +{- | Draws a list of functions over a desired range and with a desired number of points + +> > plot [sin, cos, sin.(3*)] (0,2*pi) 1000 + +-} +plotH :: [Vector Double -> Vector Double] -> (Double,Double) -> Int -> IO PlotHandle +plotH fs r n = display $ do + let ts = linspace n r + S.plot (Line,ts,mapf fs ts) +{- + withPlot (1,1) $ do + withAxis XAxis (Side Lower) $ setTickLabelFormat "%.1f" + withAxis YAxis (Side Lower) $ setTickLabelFormat "%.1f" +-} +----------------------------------------------------------------------------- + +{- | Draws a parametric curve. For instance, to draw a spiral we can do something like: + +> > parametricPlot (\t->(t * sin t, t * cos t)) (0,10*pi) 1000 + +-} +parametricPlot :: (Vector Double->(Vector Double,Vector Double)) -> (Double, Double) -> Int -> IO () +parametricPlot f r n = nohandle $ parametricPlotH f r n + +{- | Draws a parametric curve. For instance, to draw a spiral we can do something like: + +> > parametricPlot (\t->(t * sin t, t * cos t)) (0,10*pi) 1000 + +-} +parametricPlotH :: (Vector Double->(Vector Double,Vector Double)) -> (Double, Double) -> Int -> IO PlotHandle +parametricPlotH f r n = display $ do + let t = linspace n r + (fx,fy) = f t + S.plot [(Line,fx,fy)] + +----------------------------------------------------------------------------- + +-- | From vectors x and y, it generates a pair of matrices to be used as x and y arguments for matrix functions. +meshdom :: Vector Double -> Vector Double -> (Matrix Double , Matrix Double) +meshdom r1 r2 = (outer r1 (constant 1 (dim r2)), outer (constant 1 (dim r1)) r2) + +gnuplotX :: String -> IO () +gnuplotX command = do { _ <- system cmdstr; return()} where + cmdstr = "echo \""++command++"\" | gnuplot -persist" + +datafollows = "\\\"-\\\"" + +prep = (++"e\n\n") . unlines . map (unwords . (map show)) + +{- | Draws a 3D surface representation of a real matrix. + +> > mesh (hilb 20) + +In certain versions you can interactively rotate the graphic using the mouse. + +-} +mesh :: Matrix Double -> IO () +mesh m = gnuplotX (command++dat) where + command = "splot "++datafollows++" matrix with lines\n" + dat = prep $ toLists $ m + +mesh' :: Matrix Double -> IO () +mesh' m = do + writeFile "splot-gnu-command" "splot \"splot-tmp.txt\" matrix with lines; pause -1"; + toFile' "splot-tmp.txt" m + putStr "Press [Return] to close the graphic and continue... " + _ <- system "gnuplot -persist splot-gnu-command" + _ <- system "rm splot-tmp.txt splot-gnu-command" + return () + +{- | Draws the surface represented by the function f in the desired ranges and number of points, internally using 'mesh'. + +> > let f x y = cos (x + y) +> > splot f (0,pi) (0,2*pi) 50 + +-} +splot :: (Matrix Double->Matrix Double->Matrix Double) -> (Double,Double) -> (Double,Double) -> Int -> IO () +splot f rx ry n = mesh' z where + (x,y) = meshdom (linspace n rx) (linspace n ry) + z = f x y + +----------------------------------------------------------------------------- + +-- | writes a matrix to pgm image file +matrixToPGM :: Matrix Double -> String +matrixToPGM m = header ++ unlines (map unwords ll) where + c = cols m + r = rows m + header = "P2 "++show c++" "++show r++" "++show (round maxgray :: Int)++"\n" + maxgray = 255.0 + maxval = maxElement m + minval = minElement m + scale' = if (maxval == minval) + then 0.0 + else maxgray / (maxval - minval) + f x = show ( round ( scale' *(x - minval) ) :: Int ) + ll = map (map f) (toLists m) + +----------------------------------------------------------------------------- + +-- | imshow shows a representation of a matrix as a gray level image. +imshow :: Matrix Double -> IO () +imshow = nohandle . greyscaleH + +-- | greyscaleH shows a representation of a matrix as a gray level image. +greyscaleH :: Matrix Double -> IO PlotHandle +greyscaleH d = display $ S.plot d + +----------------------------------------------------------------------------- + +-- | Saves a real matrix to a formatted ascii text file +toFile' :: FilePath -> Matrix Double -> IO () +toFile' filename matrix = writeFile filename (unlines . map unwords. map (map show) . toLists $ matrix) + +gnuplotpdf :: String -> String -> [([[Double]], String)] -> IO () +gnuplotpdf title command ds = gnuplot (prelude ++ command ++" "++ draw) >> postproc where + prelude = "set terminal epslatex color; set output '"++title++".tex';" + (dats,defs) = unzip ds + draw = concat (intersperse ", " (map ("\"-\" "++) defs)) ++ "\n" ++ + concatMap pr dats + postproc = do + _ <- system $ "epstopdf "++title++".eps" + mklatex + _ <- system $ "pdflatex "++title++"aux.tex > /dev/null" + _ <- system $ "pdfcrop "++title++"aux.pdf > /dev/null" + _ <- system $ "mv "++title++"aux-crop.pdf "++title++".pdf" + _ <- system $ "rm "++title++"aux.* "++title++".eps "++title++".tex" + return () + + mklatex = writeFile (title++"aux.tex") $ + "\\documentclass{article}\n"++ + "\\usepackage{graphics}\n"++ + "\\usepackage{nopageno}\n"++ + "\\usepackage{txfonts}\n"++ + "\\renewcommand{\\familydefault}{phv}\n"++ + "\\usepackage[usenames]{color}\n"++ + + "\\begin{document}\n"++ + + "\\begin{center}\n"++ + " \\input{./"++title++".tex}\n"++ + "\\end{center}\n"++ + + "\\end{document}" + + pr = (++"e\n") . unlines . map (unwords . (map show)) + + gnuplot cmd = do + writeFile "gnuplotcommand" cmd + _ <- system "gnuplot gnuplotcommand" + _ <- system "rm gnuplotcommand" + return () + +gnuplotWin :: String -> String -> [([[Double]], String)] -> IO () +gnuplotWin title command ds = gnuplot (prelude ++ command ++" "++ draw) where + (dats,defs) = unzip ds + draw = concat (intersperse ", " (map ("\"-\" "++) defs)) ++ "\n" ++ + concatMap pr dats + + pr = (++"e\n") . unlines . map (unwords . (map show)) + + prelude = "set title \""++title++"\";" + + gnuplot cmd = do + writeFile "gnuplotcommand" cmd + _ <- system "gnuplot -persist gnuplotcommand" + _ <- system "rm gnuplotcommand" + return () + +----------------------------------------------------------------------------- diff --git a/lib/Graphics/UI/Gtk/Plot.hs b/lib/Graphics/UI/Gtk/Plot.hs new file mode 100644 --- /dev/null +++ b/lib/Graphics/UI/Gtk/Plot.hs @@ -0,0 +1,80 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.UI.Gtk.Plot +-- Copyright : (c) A. V. H. McPhail 2010 +-- License : BSD3 +-- +-- Maintainer : haskell.vivian.mcphail gmail com +-- Stability : provisional +-- Portability : portable +-- +-- A 'DrawingArea' widget that displays 'Figure's +-- +----------------------------------------------------------------------------- + +module Graphics.UI.Gtk.Plot ( + FigureHandle() + -- * Drawing Area + , plotNew + -- * Attributes + , figure + ) where + +----------------------------------------------------------------------------- + +import System.IO.Unsafe + +import Control.Concurrent.MVar + +import Control.Monad.Trans + +import System.Glib.GObject + +import Graphics.UI.Gtk + +import Graphics.Rendering.Plot.Figure + +import Graphics.Rendering.Plot.Render + +----------------------------------------------------------------------------- + +type FigureHandle = MVar FigureState + +----------------------------------------------------------------------------- + +-- | create a new 'Figure' plot +-- click on the window to save +plotNew :: FigureHandle -> IO DrawingArea +plotNew f = do + canvas <- drawingAreaNew + + set canvas [maybeFigure := (Just f)] + + _ <- on canvas exposeEvent $ tryEvent $ liftIO $ do + s <- widgetGetSize canvas + drw <- widgetGetDrawWindow canvas + fig <- get canvas figure + renderWithDrawable drw (renderFigureState fig s) + + return canvas + +----------------------------------------------------------------------------- + +-- | the figure attribute +figure :: Attr DrawingArea FigureState +figure = newAttr getFigure setFigure + where getFigure o = do + Just f <- get o maybeFigure + readMVar f + setFigure o f = set o [maybeFigure :~> (\(Just h) -> do + modifyMVar_ h (\_ -> return f) + return $ Just h)] + +----------------------------------------------------------------------------- + +maybeFigure :: Attr DrawingArea (Maybe FigureHandle) +maybeFigure = unsafePerformIO $ objectCreateAttribute +{-# NOINLINE maybeFigure #-} + +----------------------------------------------------------------------------- + diff --git a/plot-gtk.cabal b/plot-gtk.cabal new file mode 100644 --- /dev/null +++ b/plot-gtk.cabal @@ -0,0 +1,51 @@ +Name: plot-gtk +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: GTK plots and interaction with GHCi +Description: + Allows use of 'plot' package with GTK + . + * Provides a mechanism to display and update plots from GHCi + . + +Category: Graphics + +Tested-with: GHC==6.12.1 +Cabal-version: >= 1.8 +Build-type: Simple + +Extra-source-files: README, CHANGES, LICENSE + +library + + Build-Depends: base >= 4 && < 5, + mtl, + process, + glib >= 0.11 && < 0.12, + gtk >= 0.11 && < 0.12, + hmatrix >= 0.10 && < 0.11, + plot < 0.2 + + Extensions: + + hs-source-dirs: lib + + Exposed-Modules: Graphics.Rendering.Plot.Gtk + Graphics.Rendering.Plot.HMatrix + Graphics.UI.Gtk.Plot + + Other-modules: + + ghc-options: -Wall -fno-warn-unused-binds + + ghc-prof-options: -auto + + source-repository head + type: darcs + location: darcs get http://code.haskell.org/plot/gtk