module Sound.SC3.Data.Trace where
import Control.Monad
import Data.Bifunctor
import Data.List
import Data.List.Split
import Data.Maybe
import Safe
import System.FilePath.Glob
import Data.CG.Minus
import qualified Music.Theory.List as T
import qualified Music.Theory.Tuple as T
import qualified Sound.File.HSndFile as F
import Sound.SC3.Lang.Core
import Sound.SC3.Plot
type Trace t a = [(t,a)]
trace_start_time :: Num t => Trace t a -> t
trace_start_time = maybe 0 fst . headMay
trace_end_time :: Num t => Trace t a -> t
trace_end_time = maybe 0 fst . lastMay
type Window t = (t,t)
trace_window :: Num t => Trace t a -> Window t
trace_window t = (trace_start_time t,trace_end_time t)
type Lerp_F t a b = (t -> a -> a -> b)
type Time = R
trace_load_sf :: Maybe Int -> FilePath -> IO (Trace Time [R])
trace_load_sf nc fn = do
(h,t:d) <- F.read fn
let nc' = F.channelCount h
when (maybe False (/= (nc' 1)) nc) (error "trace_load_sf: incorrect nc")
return (zip t (transpose d))
trace_load_sf2 :: FilePath -> IO (Trace Time (R,R))
trace_load_sf2 =
let f = map (bimap id T.t2)
in fmap f . trace_load_sf (Just 2)
trace_load_sf_dir :: Maybe Int -> String -> IO [Trace Time [R]]
trace_load_sf_dir n p = do
nm <- glob p
mapM (trace_load_sf n) nm
trace_load_sf2_dir :: String -> IO [Trace Time (R,R)]
trace_load_sf2_dir p = do
nm <- glob p
mapM trace_load_sf2 nm
trace_map_t :: (t -> t') -> Trace t a -> Trace t' a
trace_map_t f = map (\(t,a) -> (f t,a))
trace_map :: (a -> b) -> Trace t a -> Trace t b
trace_map f = map (\(t,a) -> (t,f a))
trace_locate :: (Ord t,Fractional t) => Trace t a -> t -> Either String (((t,a),(t,a)),Trace t a)
trace_locate tr tm =
case tr of
p0:p1:r -> let (t0,_) = p0
(t1,_) = p1
in if tm < t0
then Left "trace_locate: time point before trace window"
else if tm <= t1
then Right ((p0,p1),tr)
else trace_locate (p1:r) tm
_ -> Left "trace_locate: time point after trace window"
trace_neighbours :: (Ord t,Fractional t) => Trace t a -> t -> Maybe ((t,a),(t,a))
trace_neighbours = either (const Nothing) (Just . fst) .: trace_locate
trace_neighbours_err :: (Fractional t,Ord t) => Trace t a -> t -> ((t,a),(t,a))
trace_neighbours_err = fromJust .: trace_neighbours
trace_lerp :: Fractional t => Lerp_F t a b -> t -> (t,a) -> (t,a) -> (t,b)
trace_lerp lerp_f n (t0,d0) (t1,d1) =
let i = (n t0) / (t1 t0)
in (n,lerp_f i d0 d1)
trace_lookup :: (Ord t,Fractional t) => Lerp_F t a b -> Trace t a -> t -> Maybe (t,b)
trace_lookup lerp_f t n =
let f (p0,p1) = trace_lerp lerp_f n p0 p1
in fmap f (trace_neighbours t n)
trace_lookup_def :: (Ord t,Fractional t) => b -> Lerp_F t a b -> Trace t a -> t -> (t,b)
trace_lookup_def def lerp_f t n = maybe (n,def) id (trace_lookup lerp_f t n)
trace_lookup_err :: (Ord t,Fractional t) => Lerp_F t a b -> Trace t a -> t -> (t,b)
trace_lookup_err = fromJust .:: trace_lookup
trace_lookup_seq_asc :: (Ord t,Fractional t) => Lerp_F t a b -> Trace t a -> [t] -> Trace t b
trace_lookup_seq_asc lerp_f =
let loop tr n = case n of
n0:n' -> case trace_locate tr n0 of
Right ((p0,p1),tr') -> trace_lerp lerp_f n0 p0 p1 : loop tr' n'
Left err -> error err
_ -> []
in loop
trace_normalise_t :: Fractional t => Trace t a -> Trace t a
trace_normalise_t trace =
let (t0,t1) = trace_window trace
d = t1 t0
f t = ((t t0) / d)
in trace_map_t f trace
trace_linearise :: (Ord t,Fractional t) => Int -> Lerp_F t a b -> Trace t a -> Window t -> Trace t b
trace_linearise n lerp_f t (t0,t1) = trace_lookup_seq_asc lerp_f t (iota t0 t1 n)
trace_linearise_w :: (Ord t,Fractional t) => Int -> Lerp_F t a b -> Trace t a -> Trace t b
trace_linearise_w n lerp_f t = trace_linearise n lerp_f t (trace_window t)
trace_table :: (Ord t,Fractional t) => Int -> Lerp_F t a b -> Trace t a -> [b]
trace_table = map snd .:: trace_linearise_w
trace_rescale :: (Eq t,Ord t,Fractional t) => Lerp_F t a b -> Trace t a -> Int -> Trace t b
trace_rescale lerp_f t = map (trace_lookup_err lerp_f t) . iota 0 1
trace_expand :: (Fractional t) => Lerp_F t a a -> Trace t a -> Trace t a
trace_expand lerp_f t =
let f p0 p1 = trace_lerp lerp_f (h p0 p1) p0 p1
h (t0,_) (t1,_) = ((t1 t0) / 2.0) + t0
t' = zipWith f t (tail t)
in interleave2 (t,t')
trace_expand_n :: (Fractional t,Integral n) => Lerp_F t a a -> Trace t a -> n -> Trace t a
trace_expand_n f t n =
if n == 1
then trace_expand f t
else trace_expand_n f (trace_expand f t) (n 1)
lerpn :: Num a => a -> a -> a -> a
lerpn i a b = a + ((b a) * i)
lerpn2 :: Num n => n -> (n,n) -> (n,n) -> (n,n)
lerpn2 i = T.t2_zipWith (lerpn i)
lerp_pw :: Lerp_F t a b -> t -> [a] -> [a] -> [b]
lerp_pw lerp_f i = zipWith (lerp_f i)
lerpd :: Num c => c -> [c] -> [c] -> [c]
lerpd = lerp_pw lerpn
ls_with_distance :: (Eq t,Floating t) => Ls t -> Trace t (Pt t)
ls_with_distance p =
let d = T.dx_d 0 (zipWith pt_distance p (tail p))
in zip d p
iota' :: (Eq n,Num n,Eq m,Num m) => n -> n -> n -> m -> [n]
iota' a b i n =
case n of
0 -> []
1 -> [b]
_ -> a : iota' (a + i) b i (n 1)
iota :: (Integral m,Eq n,Fractional n) => n -> n -> m -> [n]
iota a b n = iota' a b ((b a) / fromIntegral (n 1)) n
interleave2 :: ([t],[t]) -> [t]
interleave2 = concat . transpose . T.t2_list
deinterleave2 :: [a] -> ([a],[a])
deinterleave2 = T.t2 . transpose . chunksOf 2
trace2_plot_3d :: [Trace R (R,R)] -> IO ()
trace2_plot_3d = plotPath . map (map (\(t,(p,q)) -> (t,p,q)))
trace2_plot_2d :: [Trace R (R,R)] -> IO ()
trace2_plot_2d = plotCoord . map (map snd)
trace2_plot_tbl :: [Trace R (R,R)] -> IO ()
trace2_plot_tbl =
let f t = [trace_map fst t,trace_map snd t]
in plotCoord . concatMap f