module Sound.SC3.Plot where

import qualified Graphics.Gnuplot.Simple as G {- gnuplot -}
import qualified Graphics.Gnuplot.Value.Tuple as G
import Sound.SC3.Plot.Histogram
import Sound.SC3.UGen.Envelope {- hsc3 -}

eps :: G.Attribute
eps = G.EPS "/tmp/plot.eps"

-- | Plot 'Envelope' data.
--
-- > plotEnvelope [envPerc 0.2 1,envSine 1 0.75]
plotEnvelope :: (G.C t,Ord t, Floating t, Enum t) => [Envelope t] -> IO ()
plotEnvelope = G.plotLists [] . map (envelope_render 256)

-- | Plot 'Histogram' data.
--
-- > plotHistogram [histogram 3 [0,0,1,2,2,2]]
plotHistogram :: G.C t => [Histogram t] -> IO ()
plotHistogram =
    let f (Histogram x y) = zip x y
    in G.plotLists [] . map f

type Table x = [x]

-- | Plot 'Table' data, ie. /y/ values at equal /x/ increments.
--
-- > plotTable [[0,2..12],[0..6],[0,4..12]]
plotTable :: G.C t => [Table t] -> IO ()
plotTable = G.plotLists []

type Coord x = [(x,x)]

-- > plotCoord [[(0,0),(0.15,0.35),(0.75,0.25),(0.35,0.15)]]
plotCoord :: G.C t => [Coord t] -> IO ()
plotCoord =
    let s = G.defaultStyle {G.plotType = G.LinesPoints}
    in G.plotPathsStyle [] . zip (repeat s)