{-# OPTIONS_GHC -Wall #-}

{- | 
Module      :  Physics.Learn.Visual.PlotTools
Copyright   :  (c) Scott N. Walck 2011-2014
License     :  BSD3 (see LICENSE)
Maintainer  :  Scott N. Walck <walck@lvc.edu>
Stability   :  experimental

This module contains helping functions for using Gnuplot.
-}

module Physics.Learn.Visual.PlotTools
    ( label
    , postscript
    , psFile
    , examplePlot1
    , examplePlot2
    , plotXYCurve
    )
    where

import Graphics.Gnuplot.Simple
    ( Attribute(..)
    , plotFunc
    , plotPath
    )
import Physics.Learn.Curve
    ( Curve(..)
    )
import Physics.Learn.Position
    ( cartesianCoordinates
    )

-- | An 'Attribute' with a given label at a given position.
label :: String -> (Double,Double) -> Attribute
label :: FilePath -> (Double, Double) -> Attribute
label FilePath
name (Double
x,Double
y) 
  = FilePath -> [FilePath] -> Attribute
Custom FilePath
"label" [forall a. Show a => a -> FilePath
show FilePath
name forall a. [a] -> [a] -> [a]
++ FilePath
" at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Double
x forall a. [a] -> [a] -> [a]
++ FilePath
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Double
y]

-- | An 'Attribute' that requests postscript output.
postscript :: Attribute
postscript :: Attribute
postscript = FilePath -> [FilePath] -> Attribute
Custom FilePath
"term" [FilePath
"postscript"]

-- | An 'Attribute' giving the postscript file name.
psFile :: FilePath -> Attribute
psFile :: FilePath -> Attribute
psFile FilePath
file = FilePath -> [FilePath] -> Attribute
Custom FilePath
"output" [forall a. Show a => a -> FilePath
show FilePath
file]

-- | An example of the use of 'label'.  See the source code.
examplePlot1 :: IO ()
examplePlot1 :: IO ()
examplePlot1 = forall a. (C a, C a) => [Attribute] -> [a] -> (a -> a) -> IO ()
plotFunc [FilePath -> Attribute
Title FilePath
"Cosine Wave"
                        ,FilePath -> Attribute
XLabel FilePath
"Time (ms)"
                        ,FilePath -> Attribute
YLabel FilePath
"Velocity"
                        ,FilePath -> (Double, Double) -> Attribute
label FilePath
"Albert Einstein" (Double
2,Double
0.8)
                        ] [Double
0,Double
0.01..Double
10::Double] forall a. Floating a => a -> a
cos

-- | An example of the use of 'postscript' and 'psFile'.  See the source code.
examplePlot2 :: IO ()
examplePlot2 :: IO ()
examplePlot2 = forall a. (C a, C a) => [Attribute] -> [a] -> (a -> a) -> IO ()
plotFunc [FilePath -> Attribute
Title FilePath
"Cosine Wave"
                        ,FilePath -> Attribute
XLabel FilePath
"Time (ms)"
                        ,FilePath -> Attribute
YLabel FilePath
"Velocity of Car"
                        ,FilePath -> (Double, Double) -> Attribute
label FilePath
"Albert Einstein" (Double
2,Double
0.8)
                        ,Attribute
postscript
                        ,FilePath -> Attribute
psFile FilePath
"post1.ps"
                        ] [Double
0,Double
0.01..Double
10::Double] forall a. Floating a => a -> a
cos

-- | Plot a Curve in the xy plane using Gnuplot
plotXYCurve :: Curve -> IO ()
plotXYCurve :: Curve -> IO ()
plotXYCurve (Curve Double -> Position
f Double
a Double
b)
    = forall a. C a => [Attribute] -> [(a, a)] -> IO ()
plotPath [] [(Double
x,Double
y) | Double
t <- [Double
a,Double
aforall a. Num a => a -> a -> a
+Double
dt..Double
b]
                  , let (Double
x,Double
y,Double
_) = Position -> (Double, Double, Double)
cartesianCoordinates (Double -> Position
f Double
t)]
      where
        dt :: Double
dt = (Double
bforall a. Num a => a -> a -> a
-Double
a)forall a. Fractional a => a -> a -> a
/Double
1000