import Control.Monad
import Data.Function
import Data.List
import qualified Sound.Analysis.Meapsoft as M
import Sound.OSC
import Sound.SC3
import System.Environment
grain :: UGen -> UGen
grain b =
let s = control KR "start" 0.0
d = control KR "dur" 1.0
g = control KR "gain" 1.0
r = bufRateScale KR b
q = bufSampleRate KR b
z = envTrapezoid 0.95 0.5 d g
e = envGen KR 1 1 0 1 RemoveSynth z
p = playBuf 1 AR b r 1 (s * q) NoLoop DoNothing
in p * e
mk_grain :: (Transport m) => Float -> Float -> m ()
mk_grain s d =
let xs = [ ("start", s)
, ("dur", d) ]
in send (s_new "grain" (-1) AddToTail 1 xs)
tone :: UGen
tone =
let f = control KR "freq" 0.0
d = control KR "dur" 1.0
g = control KR "gain" 0.1
z = envTrapezoid 0.95 0.5 d g
e = envGen KR 1 1 0 1 RemoveSynth z
p = saw AR (mce [f, f*2, f*3]) * (mce [0.5, 0.2, 0.1])
in p * e
mk_tone :: (Transport m) => Float -> Float -> m ()
mk_tone f d =
let xs = [ ("freq", f)
, ("dur", d) ]
in send (s_new "tone" (-1) AddToTail 1 xs)
-- (Temporal_Scalar, [Segments], [Freq])
type Spec = (Float, [(Float, Float)], [Float])
type Gen_Spec = M.MEAP Float -> Spec
plyr :: Transport m => Spec -> m ()
plyr sp =
case sp of
(_, [], _) -> return ()
(t, (s,d):xs, f:fs) -> do
mk_grain s d
mk_tone f (d * t * 0.25)
pauseThread (d * t)
plyr (t, xs, fs)
_ -> undefined
run_grn :: Transport m => FilePath -> FilePath -> Gen_Spec -> m ()
run_grn sf ff rule = do
reset
let g0 = out 0 (grain 10)
g1 = out 0 tone
_ <- async (b_allocRead 10 sf 0 0)
_ <- async (d_recv (synthdef "grain" g0))
_ <- async (d_recv (synthdef "tone" g1))
(Right m) <- liftIO (M.read_meap ff)
plyr (rule m)
col :: String -> M.MEAP Float -> [Float]
col n m =
let f = M.required_feature n (M.features m)
j = M.feature_column f
in M.column_l m j
freq_1 :: M.MEAP Float -> [Float]
freq_1 = col "AvgFreqSimple"
-- forwards
rule_1 :: Gen_Spec
rule_1 c = (0.75, M.segments_l c, freq_1 c)
freq_2 :: M.MEAP Float -> [Float]
freq_2 = col "AvgSpecCentroid"
-- backwards
rule_2 :: Gen_Spec
rule_2 c = (0.5, reverse (M.segments_l c), reverse (freq_2 c))
gen_order_1 :: M.MEAP Float -> String -> [Int]
gen_order_1 m f =
let cs = zip [0..] (col f m)
cs' = sortBy (compare `on` snd) cs
in map fst cs'
apply_order :: [Int] -> [a] -> [a]
apply_order o xs = map (\i -> xs !! i) o
srt_rule :: String -> (M.MEAP Float -> [Float]) -> Gen_Spec
srt_rule n r m =
let o = gen_order_1 m n
s = apply_order o (M.segments_l m)
f = apply_order o (r m)
in (0.5, s, f)
-- sorted by segment length (ascending)
rule_3 :: Gen_Spec
rule_3 = srt_rule "chunk_length" freq_1
-- sorted by frequency (ascending)
rule_4 :: Gen_Spec
rule_4 = srt_rule "AvgFreqSimple" freq_1
-- sorted by spectral centroid (ascending)
rule_5 :: Gen_Spec
rule_5 = srt_rule "AvgSpecCentroid" freq_2
-- sorted by spectral stability (ascending)
rule_6 :: Gen_Spec
rule_6 = srt_rule "SpectralStability" freq_2
gen_sel_1 :: M.MEAP Float -> String -> (Float -> Bool) -> [Int]
gen_sel_1 m f p =
let cs = zip [0..] (col f m)
cs' = filter (p . snd) cs
in map fst cs'
sel_rule :: String -> (Float -> Bool) -> (M.MEAP Float -> [Float]) -> Gen_Spec
sel_rule n p r m =
let o = gen_sel_1 m n p
s = apply_order o (M.segments_l m)
f = apply_order o (r m)
in (0.5, s, f)
-- filtered by frequency (> 600)
rule_7 :: Gen_Spec
rule_7 = sel_rule "AvgFreqSimple" (> 600) freq_1
-- filtered by spectral centroid (> 1200)
rule_8 :: Gen_Spec
rule_8 = sel_rule "AvgSpecCentroid" (> 1200) freq_2
interleave :: [a] -> [a] -> [a]
interleave [] b = b
interleave a [] = a
interleave (a:as) (b:bs) = a : b : interleave as bs
-- interleaving of rules 4 & 5
rule_9 :: Gen_Spec
rule_9 m =
let (_, s4, f4) = rule_4 m
(_, s5, f5) = rule_5 m
in (0.75, interleave s4 s5, interleave f4 f5)
reverse_spec :: Spec -> Spec
reverse_spec (t, x, f) = (t, reverse x, reverse f)
-- reverse of rule 9
rule_10 :: Gen_Spec
rule_10 = reverse_spec . rule_9
scale_start_only :: Float -> Spec -> Spec
scale_start_only n (t, x, f) =
let g (s, d) = (s * n, d)
in (t, map g x, f)
-- rule 10 with start times compressed but durations kept equal
rule_11 :: Gen_Spec
rule_11 = (scale_start_only 0.5) . rule_10
scale_dur_only :: Float -> Spec -> Spec
scale_dur_only n (t, x, f) =
let g (s, d) = (s, d * n)
in (t, map g x, f)
-- rule 7 with durations compressed but start times retained
rule_12 :: Gen_Spec
rule_12 = (scale_dur_only 0.5) . rule_7
fix_dur :: Float -> Spec -> Spec
fix_dur n (t, x, f) =
let g (s, _) = (s, n)
in (t, map g x, f)
-- rule 7 with durations fixed at 0.25 seconds
rule_13 :: Gen_Spec
rule_13 = (fix_dur 0.25) . rule_7
rules :: [Gen_Spec]
rules = [ rule_1
, rule_2
, rule_3
, rule_4
, rule_5
, rule_6
, rule_7
, rule_8
, rule_9
, rule_10
, rule_11
, rule_12
, rule_13 ]
main :: IO ()
main = do
a <- getArgs
unless (length a == 3) (error "audio-file feature-file rule-number")
let [w_fn, f_fn, r] = a
rn = read r - 1
unless (rn >= 0 && rn < length rules) (error "unknown rule")
withSC3 (run_grn w_fn f_fn ( rules !! rn ))