module Sound.SC3.Plot where
import Control.Monad
import Data.Char
import Data.List
import Data.List.Split
import Data.Ratio
import qualified Data.Vector as V
import System.Directory
import System.FilePath
import System.Process
import Sound.OSC
import Sound.SC3
import Sound.SC3.Lang.Collection.Vector
import Sound.SC3.Plot.Histogram
minmax :: Ord t => [t] -> (t,t)
minmax l = (minimum l,maximum l)
linlin'' :: Fractional a => (a, a) -> (a, a) -> a -> a
linlin'' (l',r') (l,r) x = linlin' x l' r' l r
normalise_seq :: (Fractional b, Ord b) => (b,b) -> (b,b) -> [b] -> [b]
normalise_seq d r = map (linlin'' d r)
normalise_seq' :: (Fractional b, Ord b) => (b,b) -> [b] -> [b]
normalise_seq' (l,r) z = normalise_seq (minmax z) (l,r) z
square :: Num a => a -> a
square n = n * n
rms :: Floating a => [a] -> a
rms l =
let n = fromIntegral (length l)
s = sum (map square l)
in sqrt (s / n)
resample_rms :: Floating b => Int -> [b] -> [b]
resample_rms m l =
let n = length l
c = n `div` m
s = chunksOf c l
in map rms s
class Num n => PNum n where pshow :: n -> String
ratio_to_double :: Integral n => Ratio n -> Double
ratio_to_double = realToFrac
instance PNum Int where pshow = show
instance PNum Integer where pshow = show
instance PNum Float where pshow = show
instance PNum Double where pshow = show
instance Integral n => PNum (Ratio n) where pshow = show . ratio_to_double
type Attr = (Int,Int) -> String
attr_frac :: String -> Double -> Attr
attr_frac ty r (i,j) =
let n = fromIntegral (j i) / fromIntegral j
n' = linlin'' (0,1) (0,r) n
in "with " ++ ty ++ " lt palette frac " ++ show n'
attr_frac_lines :: Double -> Attr
attr_frac_lines = attr_frac "lines"
type Table t = [t]
plotTable :: PNum t => [Table t] -> IO ()
plotTable = mkPlot (["set palette gray","unset colorbox"],"plot",attr_frac_lines 0.5) .
map (map return)
plotTable1 :: PNum t => Table t -> IO ()
plotTable1 = plotTable . return
plotImpulses :: PNum t => [[t]] -> IO ()
plotImpulses =
mkPlot (["set palette gray"
,"unset colorbox"],"plot",attr_frac "impulses" 0.5) .
map (map return)
plot_table_displace :: (Enum t,Fractional t,Ord t,PNum t) => [[t]] -> IO ()
plot_table_displace t =
let rng = zip [0..] [1..]
t' = zipWith (normalise_seq (minmax (concat t))) rng t
in plotTable t'
plot_table_displace_nrm :: (Enum t,Fractional t,Ord t,PNum t) => [[t]] -> IO ()
plot_table_displace_nrm t =
let rng = zip [0..] [1..]
t' = zipWith normalise_seq' rng t
in plotTable t'
type P2 t = (t,t)
type Coord t = [P2 t]
plot_p2 :: PNum t => Attr -> [Coord t] -> IO ()
plot_p2 attr = do
let f (x,y) = [x,y]
mkPlot (["set palette gray","unset colorbox"],"plot",attr) . map (map f)
plot_p2_ln :: PNum t => [Coord t] -> IO ()
plot_p2_ln = plot_p2 (attr_frac_lines 0.5)
plot_p2_pt :: PNum t => [Coord t] -> IO ()
plot_p2_pt = plot_p2 (attr_frac "points pt 0" 0.5)
plot_p2_stp :: PNum t => [Coord t] -> IO ()
plot_p2_stp = plot_p2 (attr_frac "steps" 0.5)
type P3 t = (t,t,t)
type Path t = [P3 t]
plot_p3 :: PNum t => Attr -> [Path t] -> IO ()
plot_p3 attr p = do
let f (x,y,z) = [x,y,z]
mkPlot ([],"splot",attr) (map (map f) p)
plot_p3_ln :: PNum t => [Path t] -> IO ()
plot_p3_ln = plot_p3 (const "with lines")
plot_p3_pt :: PNum t => [Path t] -> IO ()
plot_p3_pt = plot_p3 (const "with points pt 0")
type Vc t = [(P2 t,P2 t)]
plotVectors :: (PNum t,Num t) => [Vc t] -> IO ()
plotVectors = do
let f ((x0,y0),(x1,y1)) = [x0,y0,x1x0,y1y0]
mkPlot ([],"plot",const "with vectors linewidth 1.25") . map (map f)
plotMatrix :: (PNum t,Num t) => [String] -> [[t]] -> IO ()
plotMatrix opt =
mkPlot (opt,"plot",const "matrix with image") .
return
plotEnvelope :: (PNum t,Ord t, Floating t, Enum t) => [Envelope t] -> IO ()
plotEnvelope = plotCoord . map (envelope_render 256)
plot_buffer1 :: (MonadIO m, DuplexOSC m) => Int -> m ()
plot_buffer1 k = do
d <- b_fetch 512 k
liftIO (plotTable1 d)
plot_buffer1_rms :: (MonadIO m, DuplexOSC m) => Int -> Int -> m ()
plot_buffer1_rms n k = do
d <- b_fetch 512 k
let d' = resample_rms n d
d'' = zipWith (*) (cycle [1,1]) d'
liftIO (plotTable1 d'')
plot_buffer1_resamp1 :: (MonadIO m, DuplexOSC m) => Int -> Int -> m ()
plot_buffer1_resamp1 n k = do
d <- b_fetch 512 k
liftIO (plot_table1_resamp1 n (V.fromList d))
plot_buffer :: (MonadIO m, DuplexOSC m) => [Int] -> m ()
plot_buffer k = do
d <- mapM (b_fetch 512) k
liftIO (plot_table_displace d)
plot_buffer_nrm :: (MonadIO m, DuplexOSC m) => [Int] -> m ()
plot_buffer_nrm k = do
d <- mapM (b_fetch 512) k
liftIO (plot_table_displace_nrm d)
plotHistogram :: PNum t => [Histogram t] -> IO ()
plotHistogram =
let f (Histogram x y) = zip x y
in plot_p2_stp . map f
plot_table1_vector :: PNum t => V.Vector t -> IO ()
plot_table1_vector = plotTable1 . V.toList
plot_table1_resamp1 :: (Enum t,RealFrac t,PNum t) => Int -> V.Vector t -> IO ()
plot_table1_resamp1 n t =
let t' = resamp1 n t
in plot_table1_vector t'
plotCoord :: PNum t => [Coord t] -> IO ()
plotCoord = plot_p2_ln
plotPoints :: PNum t => [Coord t] -> IO ()
plotPoints = plot_p2_pt
plotCoord_steps :: PNum t => [Coord t] -> IO ()
plotCoord_steps = plot_p2_stp
plotPath :: PNum t => [Path t] -> IO ()
plotPath = plot_p3_ln
type PlotSize = (Double,Double)
data PlotOpt = PlotOpt {plotSize :: Maybe PlotSize
,plotXRange :: Maybe (Double,Double)
,plotYRange :: Maybe (Double,Double)
,plotDir :: FilePath
,plotName :: String
,plotTerminal :: String
,plotGnuplotOpt :: [String]}
plotOptX11 :: PlotOpt
plotOptX11 = PlotOpt Nothing Nothing Nothing "/tmp" "mkPlot" "x11" ["-p"]
plotOptWXT :: PlotOpt
plotOptWXT = plotOptX11 {plotTerminal = "wxt"}
plotOptSVG :: PlotSize -> PlotOpt
plotOptSVG sz = PlotOpt (Just sz) Nothing Nothing "/tmp" "mkPlot" "svg" []
plotNameEnc :: PlotOpt -> String
plotNameEnc =
let f c = if isAlphaNum c then c else '_'
in map f . plotName
type PlotParam = ([String],String,Attr)
plotDataFile :: PlotOpt -> Int -> FilePath
plotDataFile opt k = plotDir opt </> plotName opt <.> show k <.> "data"
plotRCFile :: PlotOpt -> FilePath
plotRCFile opt = plotDir opt </> plotName opt <.> plotTerminal opt <.> "rc"
plotOutputFile :: PlotOpt -> FilePath
plotOutputFile opt = plotDir opt </> plotName opt <.> plotTerminal opt
writePlotRC :: PlotOpt -> PlotParam -> Int -> IO ()
writePlotRC opt (pre,cmnd,attr) n = do
let at = map (\i -> "'" ++ plotDataFile opt i ++ "' " ++ attr (i,n)) [1 .. n]
x_range = case plotXRange opt of
Just (x0,x1) -> concat ["set xrange [",show x0,":",show x1,"]"]
Nothing -> ""
y_range = case plotYRange opt of
Just (y0,y1) -> concat ["set yrange [",show y0,":",show y1,"]"]
Nothing -> ""
term = case plotSize opt of
Just (w,h) -> concat ["set terminal \""
,plotTerminal opt
,"\" name \""
,plotNameEnc opt
,"\" size ",show w,",", show h]
Nothing -> concat ["set terminal \"",plotTerminal opt,"\""]
output = case plotTerminal opt of
"svg" -> concat ["set output '",plotOutputFile opt,"'"]
_ -> ""
pre' = [term
,output
,"set tics font \"cmr10, 10\""
,x_range
,y_range
,"unset key"] ++ pre
_ <- writeFile (plotRCFile opt) (unlines pre' ++ cmnd ++ " " ++ intercalate "," at)
return ()
writePlotData :: (PNum t,Num t) => PlotOpt -> [[[t]]] -> IO ()
writePlotData opt d = do
let f = unwords . map pshow
zipWithM_ writeFile (map (plotDataFile opt) [1 .. length d]) (map (unlines . map f) d)
mkPlotOpt :: (PNum t,Num t) => PlotOpt -> PlotParam -> [[[t]]] -> IO ()
mkPlotOpt opt param dat = do
writePlotRC opt param (length dat)
writePlotData opt dat
_ <- rawSystem "gnuplot" (plotGnuplotOpt opt ++ [plotRCFile opt])
return ()
mkPlotX11 :: (PNum t,Num t) => PlotParam -> [[[t]]] -> IO ()
mkPlotX11 param dat = do
tmp <- getTemporaryDirectory
mkPlotOpt (plotOptX11 {plotDir = tmp}) param dat
mkPlotSVG :: (Num t, PNum t) => PlotSize -> PlotParam -> [[[t]]] -> IO ()
mkPlotSVG sz = mkPlotOpt (plotOptSVG sz)
mkPlot :: (PNum t,Num t) => PlotParam -> [[[t]]] -> IO ()
mkPlot param dat = do
let n = length dat
svg_opt = plotOptSVG (1200,400)
writePlotRC plotOptWXT param n
writePlotRC svg_opt param n
writePlotData plotOptWXT dat
_ <- rawSystem "gnuplot" (plotGnuplotOpt plotOptWXT ++ [plotRCFile plotOptWXT])
_ <- rawSystem "gnuplot" (plotGnuplotOpt svg_opt ++ [plotRCFile svg_opt])
return ()