{- |
This is a simple monolithic interface to gnuplot
that can be used as is in GHCi or Hugs.
We do not plan to support every feature of gnuplot here,
instead we provide an advanced modularized interface
in "Graphics.Gnuplot.Advanced".

Here is a pretty simple example:

> Graphics.Gnuplot.Simple> plotFunc [] (linearScale 1000 (-10,10::Double)) sin

This was formerly part of the htam package.
-}
module Graphics.Gnuplot.Simple (
    Attribute(..),
    Size(..),
    Aspect(..),

    LineAttr(..),
    LineSpec(..),
    PlotType(..),

    PlotStyle(..),

    linearScale,
    defaultStyle,

    terminal,

    plotList,
    plotListStyle,
    plotLists,
    plotListsStyle,
    plotFunc,
    plotFuncs,
    plotPath,
    plotPaths,
    plotPathStyle,
    plotPathsStyle,
    plotParamFunc,
    plotParamFuncs,
    plotDots,

    Plot3dType(..),
    CornersToColor(..),
    Attribute3d(..),
    plotMesh3d,
    plotFunc3d,

    epspdfPlot,
    inclPlot,
  ) where

import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D
import qualified Graphics.Gnuplot.Plot.ThreeDimensional as Plot3D
import qualified Graphics.Gnuplot.Private.LineSpecification as LineSpec
import qualified Graphics.Gnuplot.Private.Graph2D as Graph2D
import qualified Graphics.Gnuplot.Private.Graph2DType as GraphType
import qualified Graphics.Gnuplot.Private.Graph as Graph
import qualified Graphics.Gnuplot.Private.Plot as Plot

import qualified Graphics.Gnuplot.Value.Tuple as Tuple
import qualified Graphics.Gnuplot.Value.Atom as Atom

{-
import qualified Graphics.Gnuplot.Terminal.PostScript as PS
import qualified Graphics.Gnuplot.Terminal.PNG as PNG
import qualified Graphics.Gnuplot.Terminal.SVG as SVG
-}

import qualified Graphics.Gnuplot.Private.Terminal as Terminal

import Graphics.Gnuplot.Utility
   (quote, commaConcat, semiColonConcat, showTriplet, linearScale, )

import qualified Control.Monad.Trans.Reader as MR
import qualified Control.Monad.Trans.State as MS

import qualified Graphics.Gnuplot.Private.Command as Cmd
import System.Process (rawSystem, )
import Control.Functor.HT (void, )

import qualified Data.List.Reverse.StrictElement as ListRev
import Data.Foldable (foldMap, )
import Data.Maybe (listToMaybe, mapMaybe, isNothing, )


-- * User front-end

data Attribute =
     Custom String [String]  -- ^ anything that is allowed after gnuplot's @set@ command
   | EPS    FilePath
   | PNG    FilePath
   | Terminal Terminal.T     -- ^ you cannot use this, call 'terminal' instead
   | Grid   (Maybe [String])
   | Key    (Maybe [String])
   | Border (Maybe [String])
   | XTicks (Maybe [String])
   | YTicks (Maybe [String])
   | Size   (Size)
   | Aspect (Aspect)
   | BoxAspect (Aspect)
   | LineStyle Int [LineAttr]
   | Title  String
   | XLabel String
   | YLabel String
   | ZLabel String
   | XRange (Double, Double)
   | YRange (Double, Double)
   | ZRange (Double, Double)
   | Palette [(Double, (Double, Double, Double))]
   | ColorBox (Maybe [String])
   | XTime
   | XFormat String

data Size =
     Scale    Double
   | SepScale Double Double

data Aspect =
     Ratio Double
   | NoRatio

{- |
Be careful with 'LineTitle'
which can only be used as part of gnuplot's @plot@ command
but not as part of @set@.
That is,

> plotList [LineStyle 0 [LineTitle "foobar"]] [0,5..100::Double]

will leave you with an invalid gnuplot script, whereas

> plotListStyle [] (defaultStyle {lineSpec = CustomStyle [LineTitle "foobar"]}) [0,5..100::Double]

does what you want.

The 'Int' types would be better enumerations
but their interpretations depend on the gnuplot output type. :-(
-}
data LineAttr =
     LineType  Int
   | LineWidth Double
   | PointType Int
   | PointSize Double
   | LineTitle String

data LineSpec =
     DefaultStyle Int
   | CustomStyle  [LineAttr]

data PlotType =
     Lines
   | Points
   | LinesPoints
   | Impulses
   | Dots
   | Steps
   | FSteps
   | HiSteps
   | ErrorBars
   | XErrorBars
   | YErrorBars
   | XYErrorBars
   | ErrorLines
   | XErrorLines
   | YErrorLines
   | XYErrorLines
   | Boxes
   | FilledCurves
   | BoxErrorBars
   | BoxXYErrorBars
   | FinanceBars
   | CandleSticks
   | Vectors
   | PM3d

data PlotStyle = PlotStyle { PlotStyle -> PlotType
plotType :: PlotType, PlotStyle -> LineSpec
lineSpec :: LineSpec }



defaultStyle :: PlotStyle
defaultStyle :: PlotStyle
defaultStyle = PlotType -> LineSpec -> PlotStyle
PlotStyle PlotType
Lines ([LineAttr] -> LineSpec
CustomStyle [])


terminal :: Terminal.C term => term -> Attribute
terminal :: term -> Attribute
terminal =
   T -> Attribute
Terminal (T -> Attribute) -> (term -> T) -> term -> Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. term -> T
forall terminal. C terminal => terminal -> T
Terminal.canonical


-- * plot functions

list :: (Tuple.C a) => [a] -> Plot2D.T Double Double
list :: [a] -> T Double Double
list = T Double Double a -> [a] -> T Double Double
forall x y a. (C x, C y, C a) => T x y a -> [a] -> T x y
Plot2D.list (String -> T Double Double a
forall x y a. String -> T x y a
GraphType.Cons String
"lines")
-- list = Plot2D.list GraphType.listLines

{- |
> plotList [] (take 30 (let fibs = 0 : 1 : zipWith (+) fibs (tail fibs) in fibs))
-}
plotList ::
   (Tuple.C a) =>
   [Attribute] -> [a] -> IO ()
plotList :: [Attribute] -> [a] -> IO ()
plotList [Attribute]
attrs =
   [Attribute] -> T Double Double -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T Double Double -> IO ())
-> ([a] -> T Double Double) -> [a] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> T Double Double
forall a. C a => [a] -> T Double Double
list

{- |
> plotListStyle [] (defaultStyle{plotType = CandleSticks}) (Plot2D.functionToGraph (linearScale 32 (0,2*pi::Double)) (\t -> (-sin t, -2*sin t, 2*sin t, sin t)))
-}
plotListStyle ::
   (Tuple.C a) =>
   [Attribute] -> PlotStyle -> [a] -> IO ()
plotListStyle :: [Attribute] -> PlotStyle -> [a] -> IO ()
plotListStyle [Attribute]
attrs PlotStyle
style =
   [Attribute] -> T Double Double -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T Double Double -> IO ())
-> ([a] -> T Double Double) -> [a] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlotStyle -> T Double Double -> T Double Double
forall x y. PlotStyle -> T x y -> T x y
setPlotStyle PlotStyle
style (T Double Double -> T Double Double)
-> ([a] -> T Double Double) -> [a] -> T Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> T Double Double
forall a. C a => [a] -> T Double Double
list

plotLists ::
   (Tuple.C a) =>
   [Attribute] -> [[a]] -> IO ()
plotLists :: [Attribute] -> [[a]] -> IO ()
plotLists [Attribute]
attrs [[a]]
xss =
   [Attribute] -> T Double Double -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (([a] -> T Double Double) -> [[a]] -> T Double Double
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [a] -> T Double Double
forall a. C a => [a] -> T Double Double
list [[a]]
xss)

plotListsStyle ::
   (Tuple.C a) =>
   [Attribute] -> [(PlotStyle, [a])] -> IO ()
plotListsStyle :: [Attribute] -> [(PlotStyle, [a])] -> IO ()
plotListsStyle [Attribute]
attrs =
   [Attribute] -> T Double Double -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T Double Double -> IO ())
-> ([(PlotStyle, [a])] -> T Double Double)
-> [(PlotStyle, [a])]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((PlotStyle, [a]) -> T Double Double)
-> [(PlotStyle, [a])] -> T Double Double
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(PlotStyle
style,[a]
xs) -> PlotStyle -> T Double Double -> T Double Double
forall x y. PlotStyle -> T x y -> T x y
setPlotStyle PlotStyle
style (T Double Double -> T Double Double)
-> T Double Double -> T Double Double
forall a b. (a -> b) -> a -> b
$ [a] -> T Double Double
forall a. C a => [a] -> T Double Double
list [a]
xs)

{- |
> plotFunc [] (linearScale 1000 (-10,10)) sin
-}
plotFunc ::
   (Atom.C a, Tuple.C a) =>
   [Attribute] -> [a] -> (a -> a) -> IO ()
plotFunc :: [Attribute] -> [a] -> (a -> a) -> IO ()
plotFunc [Attribute]
attrs [a]
args a -> a
f =
   [Attribute] -> T a a -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T a a (a, a) -> [a] -> (a -> a) -> T a a
forall x y a b.
(C x, C y, C a, C b) =>
T x y (a, b) -> [a] -> (a -> b) -> T x y
Plot2D.function T a a (a, a)
forall x y. (C x, C y) => T x y (x, y)
GraphType.lines [a]
args a -> a
f)

{- |
> plotFuncs [] (linearScale 1000 (-10,10)) [sin, cos]
-}
plotFuncs ::
   (Atom.C a, Tuple.C a) =>
   [Attribute] -> [a] -> [a -> a] -> IO ()
plotFuncs :: [Attribute] -> [a] -> [a -> a] -> IO ()
plotFuncs [Attribute]
attrs [a]
args [a -> a]
fs =
   [Attribute] -> T a a -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T a a (a, a) -> [a] -> [a -> a] -> T a a
forall x y a b.
(C x, C y, C a, C b) =>
T x y (a, b) -> [a] -> [a -> b] -> T x y
Plot2D.functions T a a (a, a)
forall x y. (C x, C y) => T x y (x, y)
GraphType.lines [a]
args [a -> a]
fs)

plotPath ::
   (Tuple.C a) =>
   [Attribute] -> [(a,a)] -> IO ()
plotPath :: [Attribute] -> [(a, a)] -> IO ()
plotPath [Attribute]
attrs =
   [Attribute] -> T Double Double -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T Double Double -> IO ())
-> ([(a, a)] -> T Double Double) -> [(a, a)] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> T Double Double
forall a. C a => [a] -> T Double Double
list

plotPaths ::
   (Tuple.C a) =>
   [Attribute] -> [[(a,a)]] -> IO ()
plotPaths :: [Attribute] -> [[(a, a)]] -> IO ()
plotPaths [Attribute]
attrs [[(a, a)]]
xss =
   [Attribute] -> T Double Double -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (([(a, a)] -> T Double Double) -> [[(a, a)]] -> T Double Double
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [(a, a)] -> T Double Double
forall a. C a => [a] -> T Double Double
list [[(a, a)]]
xss)

plotPathStyle ::
   (Tuple.C a) =>
   [Attribute] -> PlotStyle -> [(a,a)] -> IO ()
plotPathStyle :: [Attribute] -> PlotStyle -> [(a, a)] -> IO ()
plotPathStyle [Attribute]
attrs PlotStyle
style =
   [Attribute] -> T Double Double -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T Double Double -> IO ())
-> ([(a, a)] -> T Double Double) -> [(a, a)] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlotStyle -> T Double Double -> T Double Double
forall x y. PlotStyle -> T x y -> T x y
setPlotStyle PlotStyle
style (T Double Double -> T Double Double)
-> ([(a, a)] -> T Double Double) -> [(a, a)] -> T Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, a)] -> T Double Double
forall a. C a => [a] -> T Double Double
list

plotPathsStyle ::
   (Tuple.C a) =>
   [Attribute] -> [(PlotStyle, [(a,a)])] -> IO ()
plotPathsStyle :: [Attribute] -> [(PlotStyle, [(a, a)])] -> IO ()
plotPathsStyle [Attribute]
attrs =
   [Attribute] -> T Double Double -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T Double Double -> IO ())
-> ([(PlotStyle, [(a, a)])] -> T Double Double)
-> [(PlotStyle, [(a, a)])]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((PlotStyle, [(a, a)]) -> T Double Double)
-> [(PlotStyle, [(a, a)])] -> T Double Double
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(PlotStyle
style,[(a, a)]
xs) -> PlotStyle -> T Double Double -> T Double Double
forall x y. PlotStyle -> T x y -> T x y
setPlotStyle PlotStyle
style (T Double Double -> T Double Double)
-> T Double Double -> T Double Double
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> T Double Double
forall a. C a => [a] -> T Double Double
list [(a, a)]
xs)

{- |
> plotParamFunc [] (linearScale 1000 (0,2*pi)) (\t -> (sin (2*t), cos t))
-}
plotParamFunc ::
   (Atom.C a, Tuple.C a) =>
   [Attribute] -> [a] -> (a -> (a,a)) -> IO ()
plotParamFunc :: [Attribute] -> [a] -> (a -> (a, a)) -> IO ()
plotParamFunc [Attribute]
attrs [a]
args a -> (a, a)
f =
   [Attribute] -> T a a -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T a a (a, a) -> [a] -> (a -> (a, a)) -> T a a
forall x y a t.
(C x, C y, C a) =>
T x y a -> [t] -> (t -> a) -> T x y
Plot2D.parameterFunction T a a (a, a)
forall x y. (C x, C y) => T x y (x, y)
GraphType.lines [a]
args a -> (a, a)
f)

{- |
> plotParamFuncs [] (linearScale 1000 (0,2*pi)) [\t -> (sin (2*t), cos t), \t -> (cos t, sin (2*t))]
-}
plotParamFuncs ::
   (Atom.C a, Tuple.C a) =>
   [Attribute] -> [a] -> [a -> (a,a)] -> IO ()
plotParamFuncs :: [Attribute] -> [a] -> [a -> (a, a)] -> IO ()
plotParamFuncs [Attribute]
attrs [a]
args [a -> (a, a)]
fs =
   [Attribute] -> T a a -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T a a -> IO ()) -> T a a -> IO ()
forall a b. (a -> b) -> a -> b
$
   ((a -> (a, a)) -> T a a) -> [a -> (a, a)] -> T a a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (T a a (a, a) -> [a] -> (a -> (a, a)) -> T a a
forall x y a t.
(C x, C y, C a) =>
T x y a -> [t] -> (t -> a) -> T x y
Plot2D.parameterFunction T a a (a, a)
forall x y. (C x, C y) => T x y (x, y)
GraphType.lines [a]
args) [a -> (a, a)]
fs


plotDots ::
   (Atom.C a, Tuple.C a) =>
   [Attribute] -> [(a,a)] -> IO ()
plotDots :: [Attribute] -> [(a, a)] -> IO ()
plotDots [Attribute]
attrs [(a, a)]
xs =
   [Attribute] -> T a a -> IO ()
forall x y. (C x, C y) => [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs (T a a (a, a) -> [(a, a)] -> T a a
forall x y a. (C x, C y, C a) => T x y a -> [a] -> T x y
Plot2D.list T a a (a, a)
forall x y. (C x, C y) => T x y (x, y)
GraphType.dots [(a, a)]
xs)



data Plot3dType =
     Surface
   | ColorMap

data CornersToColor =
     Mean
   | GeometricMean
   | Median
   | Corner1
   | Corner2
   | Corner3
   | Corner4

data Attribute3d =
     Plot3dType     Plot3dType
   | CornersToColor CornersToColor


{- |
> let xs = [-2,-1.8..2::Double] in plotMesh3d [] [] (do x <- xs; return (do y <- xs; return (x,y,cos(x*x+y*y))))

> let phis = linearScale 30 (-pi, pi :: Double) in plotMesh3d [] [] (do phi <- phis; return (do psi <- phis; let r = 5 + sin psi in return (r * cos phi, r * sin phi, cos psi)))
-}
plotMesh3d ::
   (Atom.C x, Atom.C y, Atom.C z,
    Tuple.C x, Tuple.C y, Tuple.C z) =>
   [Attribute] -> [Attribute3d] -> [[(x,y,z)]] -> IO ()
plotMesh3d :: [Attribute] -> [Attribute3d] -> [[(x, y, z)]] -> IO ()
plotMesh3d [Attribute]
attrs [Attribute3d]
pt [[(x, y, z)]]
dat =
   [Attribute] -> [Attribute3d] -> T x y z -> IO ()
forall x y z.
(C x, C y, C z) =>
[Attribute] -> [Attribute3d] -> T x y z -> IO ()
plot3d [Attribute]
attrs [Attribute3d]
pt ([[(x, y, z)]] -> T x y z
forall x y z.
(C x, C y, C z, C x, C y, C z) =>
[[(x, y, z)]] -> T x y z
Plot3D.mesh [[(x, y, z)]]
dat)

{- |
> let xs = [-2,-1.8..2::Double] in plotFunc3d [] [] xs xs (\x y -> exp(-(x*x+y*y)))
-}
plotFunc3d ::
   (Atom.C x, Atom.C y, Atom.C z,
    Tuple.C x, Tuple.C y, Tuple.C z) =>
   [Attribute] -> [Attribute3d] -> [x] -> [y] -> (x -> y -> z) -> IO ()
plotFunc3d :: [Attribute]
-> [Attribute3d] -> [x] -> [y] -> (x -> y -> z) -> IO ()
plotFunc3d [Attribute]
attrs [Attribute3d]
pt [x]
xArgs [y]
yArgs x -> y -> z
f =
   [Attribute] -> [Attribute3d] -> T x y z -> IO ()
forall x y z.
(C x, C y, C z) =>
[Attribute] -> [Attribute3d] -> T x y z -> IO ()
plot3d [Attribute]
attrs [Attribute3d]
pt ([x] -> [y] -> (x -> y -> z) -> T x y z
forall x y z.
(C x, C y, C z, C x, C y, C z) =>
[x] -> [y] -> (x -> y -> z) -> T x y z
Plot3D.surface [x]
xArgs [y]
yArgs x -> y -> z
f)



-- * For inclusion of gnuplot graphics in LaTeX documents using lhs2TeX

{-| Redirects the output of a plotting function to an EPS file
    and additionally converts it to PDF. -}
epspdfPlot ::
      FilePath
   -> ([Attribute] -> IO ())  {-^ Drawing function that expects some gnuplot attributes. -}
   -> IO ()
epspdfPlot :: String -> ([Attribute] -> IO ()) -> IO ()
epspdfPlot String
filename [Attribute] -> IO ()
plot =
   do [Attribute] -> IO ()
plot (String -> Attribute
EPS (String
filenameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
".eps") Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: Maybe [String] -> Attribute
Key Maybe [String]
forall a. Maybe a
Nothing Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: [])
      IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO ExitCode
rawSystem String
"epstopdf" [String
filenameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
".eps"]

{-| Creates an EPS and a PDF graphics
    and returns a string that can be inserted into a LaTeX document
    to include this graphic.

    Different from GHCi, Hugs doesn't output a return value from an IO monad.
    So you must wrap it with a 'putStr'.
    Nevertheless this implementation which returns the LaTeX command as string
    is the most flexible one. -}
inclPlot ::
      FilePath
   -> ([Attribute] -> IO ())  {-^ Drawing function that expects some gnuplot attributes. -}
   -> IO String
inclPlot :: String -> ([Attribute] -> IO ()) -> IO String
inclPlot String
filename [Attribute] -> IO ()
plot =
   do String -> ([Attribute] -> IO ()) -> IO ()
epspdfPlot String
filename [Attribute] -> IO ()
plot
      String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"\\includegraphics{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
filenameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}")



-- * Internal functions

attrToProg :: Attribute -> String
attrToProg :: Attribute -> String
attrToProg (Custom String
attribute [String]
parameters) =
   String
"set " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
attribute String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
parameters

attrToProg (Terminal T
term) =
   [String] -> String
semiColonConcat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ T -> [String]
Terminal.format T
term

attrToProg (EPS String
filename) =
   String
"set terminal postscript eps; " String -> String -> String
forall a. [a] -> [a] -> [a]
++  -- latex
   String
"set output " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote String
filename

attrToProg (PNG String
filename) =
   String
"set terminal png; " String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
"set output " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote String
filename

attrToProg (Grid   (Just [String]
x))     = String
"set grid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
x
attrToProg (Grid   Maybe [String]
Nothing)      = String
"set nogrid"
attrToProg (Key    (Just [String]
x))     = String
"set key " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
x
attrToProg (Key    Maybe [String]
Nothing)      = String
"set nokey"
attrToProg (Border (Just [String]
x))     = String
"set border " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
x
attrToProg (Border Maybe [String]
Nothing)      = String
"set noborder"
attrToProg (XTicks (Just [String]
x))     = String
"set xtics " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
x
attrToProg (XTicks Maybe [String]
Nothing)      = String
"set noxtics"
attrToProg (YTicks (Just [String]
x))     = String
"set ytics " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
x
attrToProg (YTicks Maybe [String]
Nothing)      = String
"set noytics"
attrToProg (Size (Scale Double
c))      = String
"set size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
c
attrToProg (Size (SepScale Double
x Double
y)) = String
"set size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
y
attrToProg (Aspect (Ratio Double
r))    = String
"set size ratio " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show (-Double
r)
attrToProg (Aspect (Aspect
NoRatio))    = String
"set size noratio"
attrToProg (BoxAspect (Ratio Double
r)) = String
"set size ratio " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
r
attrToProg (BoxAspect (Aspect
NoRatio)) = String
"set size noratio"
attrToProg (LineStyle Int
num [LineAttr]
style) =
   String
"set linestyle " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
num String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
   T -> String
LineSpec.toString ([LineAttr] -> T -> T
lineAttrRecord [LineAttr]
style T
LineSpec.deflt)
attrToProg (Title  String
title_)       = String
"set title " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote String
title_
attrToProg (XLabel String
label)        = String
"set xlabel " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote String
label
attrToProg (YLabel String
label)        = String
"set ylabel " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote String
label
attrToProg (ZLabel String
label)        = String
"set zlabel " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote String
label
attrToProg (XRange (Double, Double)
_)            = String
""  -- xrange is handled in plot command
attrToProg (YRange (Double, Double)
_)            = String
""  -- yrange is handled in plot command
attrToProg (ZRange (Double, Double)
_)            = String
""  -- zrange is handled in plot command
attrToProg (Palette [(Double, (Double, Double, Double))]
colors) =
   String
"set palette defined (" String -> String -> String
forall a. [a] -> [a] -> [a]
++
     [String] -> String
commaConcat (((Double, (Double, Double, Double)) -> String)
-> [(Double, (Double, Double, Double))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
idx,(Double, Double, Double)
c) -> Double -> String
forall a. Show a => a -> String
show Double
idx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Double, Double, Double) -> String
forall a b c. (Show a, Show b, Show c) => (a, b, c) -> String
showTriplet (Double, Double, Double)
c) [(Double, (Double, Double, Double))]
colors) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
attrToProg (ColorBox (Just [String]
x))     = String
"set colorbox " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
x
attrToProg (ColorBox Maybe [String]
Nothing)      = String
"unset colorbox"
attrToProg Attribute
XTime                   = String
"set xdata time; set timefmt \"%s\""
attrToProg (XFormat String
fmt)           = String
"set format x " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote String
fmt

xRangeFromAttr, yRangeFromAttr, zRangeFromAttr ::
   Attribute -> Maybe (Double, Double)
xRangeFromAttr :: Attribute -> Maybe (Double, Double)
xRangeFromAttr (XRange (Double, Double)
rng) = (Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Double, Double)
rng
xRangeFromAttr Attribute
_            = Maybe (Double, Double)
forall a. Maybe a
Nothing

yRangeFromAttr :: Attribute -> Maybe (Double, Double)
yRangeFromAttr (YRange (Double, Double)
rng) = (Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Double, Double)
rng
yRangeFromAttr Attribute
_            = Maybe (Double, Double)
forall a. Maybe a
Nothing

zRangeFromAttr :: Attribute -> Maybe (Double, Double)
zRangeFromAttr (ZRange (Double, Double)
rng) = (Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Double, Double)
rng
zRangeFromAttr Attribute
_            = Maybe (Double, Double)
forall a. Maybe a
Nothing

extractRanges :: [Attribute] -> String
extractRanges :: [Attribute] -> String
extractRanges [Attribute]
attrs =
   let ranges :: [Maybe (Double, Double)]
ranges = ((Attribute -> Maybe (Double, Double)) -> Maybe (Double, Double))
-> [Attribute -> Maybe (Double, Double)]
-> [Maybe (Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ([(Double, Double)] -> Maybe (Double, Double)
forall a. [a] -> Maybe a
listToMaybe ([(Double, Double)] -> Maybe (Double, Double))
-> ((Attribute -> Maybe (Double, Double)) -> [(Double, Double)])
-> (Attribute -> Maybe (Double, Double))
-> Maybe (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Attribute -> Maybe (Double, Double))
 -> [Attribute] -> [(Double, Double)])
-> [Attribute]
-> (Attribute -> Maybe (Double, Double))
-> [(Double, Double)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Attribute -> Maybe (Double, Double))
-> [Attribute] -> [(Double, Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Attribute]
attrs)
                    [Attribute -> Maybe (Double, Double)
xRangeFromAttr, Attribute -> Maybe (Double, Double)
yRangeFromAttr, Attribute -> Maybe (Double, Double)
zRangeFromAttr]
       showRng :: (a, a) -> String
showRng (a
l,a
r) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
   in  [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Maybe (Double, Double) -> String)
-> [Maybe (Double, Double)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
-> ((Double, Double) -> String) -> Maybe (Double, Double) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"[:]" (Double, Double) -> String
forall a a. (Show a, Show a) => (a, a) -> String
showRng) ((Maybe (Double, Double) -> Bool)
-> [Maybe (Double, Double)] -> [Maybe (Double, Double)]
forall a. (a -> Bool) -> [a] -> [a]
ListRev.dropWhile Maybe (Double, Double) -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe (Double, Double)]
ranges)

interactiveTerm :: [Attribute] -> Bool
interactiveTerm :: [Attribute] -> Bool
interactiveTerm =
   (Attribute -> Bool) -> [Attribute] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Attribute -> Bool) -> [Attribute] -> Bool)
-> (Attribute -> Bool) -> [Attribute] -> Bool
forall a b. (a -> b) -> a -> b
$ \Attribute
attr ->
      case Attribute
attr of
         Terminal T
term -> T -> Bool
Terminal.interactive T
term
         PNG String
_ -> Bool
False
         EPS String
_ -> Bool
False
         Attribute
_ -> Bool
True



plotTypeToGraph :: PlotType -> Graph2D.Type -- GraphType.T
plotTypeToGraph :: PlotType -> String
plotTypeToGraph PlotType
t =
   case PlotType
t of
      PlotType
Lines          -> String
"lines"
      PlotType
Points         -> String
"points"
      PlotType
LinesPoints    -> String
"linespoints"
      PlotType
Impulses       -> String
"impulses"
      PlotType
Dots           -> String
"dots"
      PlotType
Steps          -> String
"steps"
      PlotType
FSteps         -> String
"fsteps"
      PlotType
HiSteps        -> String
"histeps"
      PlotType
ErrorBars      -> String
"errorbars"
      PlotType
XErrorBars     -> String
"xerrorbars"
      PlotType
YErrorBars     -> String
"yerrorbars"
      PlotType
XYErrorBars    -> String
"xyerrorbars"
      PlotType
ErrorLines     -> String
"errorlines"
      PlotType
XErrorLines    -> String
"xerrorlines"
      PlotType
YErrorLines    -> String
"yerrorlines"
      PlotType
XYErrorLines   -> String
"xyerrorlines"
      PlotType
Boxes          -> String
"boxes"
      PlotType
FilledCurves   -> String
"filledcurves"
      PlotType
BoxErrorBars   -> String
"boxerrorbars"
      PlotType
BoxXYErrorBars -> String
"boxxyerrorbars"
      PlotType
FinanceBars    -> String
"financebars"
      PlotType
CandleSticks   -> String
"candlesticks"
      PlotType
Vectors        -> String
"vectors"
      PlotType
PM3d           -> String
"pm3d"


plot3dTypeToString :: Plot3dType -> String
plot3dTypeToString :: Plot3dType -> String
plot3dTypeToString Plot3dType
Surface  = String
""
plot3dTypeToString Plot3dType
ColorMap = String
"map"

cornersToColorToString :: CornersToColor -> String
cornersToColorToString :: CornersToColor -> String
cornersToColorToString CornersToColor
Mean          = String
"mean"
cornersToColorToString CornersToColor
GeometricMean = String
"geomean"
cornersToColorToString CornersToColor
Median        = String
"median"
cornersToColorToString CornersToColor
Corner1       = String
"c1"
cornersToColorToString CornersToColor
Corner2       = String
"c2"
cornersToColorToString CornersToColor
Corner3       = String
"c3"
cornersToColorToString CornersToColor
Corner4       = String
"c4"

attribute3dToString :: Attribute3d -> String
attribute3dToString :: Attribute3d -> String
attribute3dToString (Plot3dType     Plot3dType
pt)  = Plot3dType -> String
plot3dTypeToString Plot3dType
pt
attribute3dToString (CornersToColor CornersToColor
c2c) =
   String
"corners2color " String -> String -> String
forall a. [a] -> [a] -> [a]
++CornersToColor -> String
cornersToColorToString CornersToColor
c2c



plot2d ::
   (Atom.C x, Atom.C y) =>
   [Attribute] -> Plot2D.T x y -> IO ()
plot2d :: [Attribute] -> T x y -> IO ()
plot2d [Attribute]
attrs T x y
plt =
   [Attribute] -> String -> T x y -> IO ()
forall graph. C graph => [Attribute] -> String -> T graph -> IO ()
runGnuplot [Attribute]
attrs String
"plot" T x y
plt

setPlotStyle :: PlotStyle -> Plot2D.T x y -> Plot2D.T x y
setPlotStyle :: PlotStyle -> T x y -> T x y
setPlotStyle PlotStyle
ps =
   (T x y -> T x y) -> T x y -> T x y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> T x y -> T x y
forall x y. String -> T x y -> T x y
Graph2D.typ (PlotType -> String
plotTypeToGraph (PlotType -> String) -> PlotType -> String
forall a b. (a -> b) -> a -> b
$ PlotStyle -> PlotType
plotType PlotStyle
ps) (T x y -> T x y) -> (T x y -> T x y) -> T x y -> T x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         T -> T x y -> T x y
forall x y. T -> T x y -> T x y
Graph2D.lineSpec (LineSpec -> T
lineSpecRecord (LineSpec -> T) -> LineSpec -> T
forall a b. (a -> b) -> a -> b
$ PlotStyle -> LineSpec
lineSpec PlotStyle
ps))


plot3d ::
   (Atom.C x, Atom.C y, Atom.C z) =>
   [Attribute] -> [Attribute3d] -> Plot3D.T x y z -> IO ()
plot3d :: [Attribute] -> [Attribute3d] -> T x y z -> IO ()
plot3d [Attribute]
attrs [Attribute3d]
pt T x y z
plt =
   [Attribute] -> String -> T x y z -> IO ()
forall graph. C graph => [Attribute] -> String -> T graph -> IO ()
runGnuplot
      (String -> [String] -> Attribute
Custom String
"pm3d" ((Attribute3d -> String) -> [Attribute3d] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute3d -> String
attribute3dToString [Attribute3d]
pt) Attribute -> [Attribute] -> [Attribute]
forall a. a -> [a] -> [a]
: [Attribute]
attrs) String
"splot" T x y z
plt


lineSpecRecord :: LineSpec -> LineSpec.T
lineSpecRecord :: LineSpec -> T
lineSpecRecord (DefaultStyle Int
n) =
   Int -> T -> T
LineSpec.lineStyle Int
n T
LineSpec.deflt
lineSpecRecord (CustomStyle [LineAttr]
ls) =
   [LineAttr] -> T -> T
lineAttrRecord [LineAttr]
ls T
LineSpec.deflt

lineAttrRecord :: [LineAttr] -> LineSpec.T -> LineSpec.T
lineAttrRecord :: [LineAttr] -> T -> T
lineAttrRecord =
   (T -> [LineAttr] -> T) -> [LineAttr] -> T -> T
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((T -> [LineAttr] -> T) -> [LineAttr] -> T -> T)
-> (T -> [LineAttr] -> T) -> [LineAttr] -> T -> T
forall a b. (a -> b) -> a -> b
$ (T -> LineAttr -> T) -> T -> [LineAttr] -> T
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((LineAttr -> T -> T) -> T -> LineAttr -> T
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((LineAttr -> T -> T) -> T -> LineAttr -> T)
-> (LineAttr -> T -> T) -> T -> LineAttr -> T
forall a b. (a -> b) -> a -> b
$ \LineAttr
attr ->
      case LineAttr
attr of
         LineType  Int
n -> Int -> T -> T
LineSpec.lineType  Int
n
         LineWidth Double
w -> Double -> T -> T
LineSpec.lineWidth Double
w
         PointType Int
n -> Int -> T -> T
LineSpec.pointType Int
n
         PointSize Double
s -> Double -> T -> T
LineSpec.pointSize Double
s
         LineTitle String
s -> String -> T -> T
LineSpec.title     String
s
      )

runGnuplot ::
   Graph.C graph =>
   [Attribute] -> String -> Plot.T graph -> IO ()
runGnuplot :: [Attribute] -> String -> T graph -> IO ()
runGnuplot [Attribute]
attrs String
cmd (Plot.Cons StateT Int (Reader String) [File graph]
mp) =
   IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO ExitCode -> IO ExitCode
Cmd.asyncIfInteractive ([Attribute] -> Bool
interactiveTerm [Attribute]
attrs) (IO ExitCode -> IO ExitCode) -> IO ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ (String -> ([String], [File graph])) -> IO ExitCode
forall file.
C file =>
(String -> ([String], [file])) -> IO ExitCode
Cmd.run ((String -> ([String], [File graph])) -> IO ExitCode)
-> (String -> ([String], [File graph])) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \String
dir ->
      let files :: [File graph]
files = Reader String [File graph] -> String -> [File graph]
forall r a. Reader r a -> r -> a
MR.runReader (StateT Int (Reader String) [File graph]
-> Int -> Reader String [File graph]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
MS.evalStateT StateT Int (Reader String) [File graph]
mp Int
0) String
dir
      in  ((Attribute -> String) -> [Attribute] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> String
attrToProg [Attribute]
attrs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
           [String
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            [Attribute] -> String
extractRanges [Attribute]
attrs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            [String] -> String
commaConcat ([File graph] -> [String]
forall graph. C graph => [File graph] -> [String]
plotFileStatements [File graph]
files)],
           [File graph]
files)

plotFileStatements ::
   Graph.C graph => [Plot.File graph] -> [String]
plotFileStatements :: [File graph] -> [String]
plotFileStatements =
   (File graph -> [String]) -> [File graph] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      (\(Plot.File String
filename Maybe String
_ [graph]
grs) ->
         (graph -> String) -> [graph] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\graph
gr -> String -> String
quote String
filename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ graph -> String
forall graph. C graph => graph -> String
Graph.toString graph
gr) [graph]
grs)