hmeap-utils 0.11 → 0.14
raw patch · 4 files changed
+113/−89 lines, 4 filesdep ~hmeapdep ~hoscdep ~hsc3
Dependency ranges changed: hmeap, hosc, hsc3
Files
- README +24/−9
- cmd/browse.hs +1/−1
- cmd/play.hs +81/−72
- hmeap-utils.cabal +7/−7
README view
@@ -1,12 +1,27 @@-hmeap-utils - hmeap utilities+hmeap-utils+----------- -Simple hmeap utilities that illustrate hmeap use with-hmatrix, gnuplot and hsc3.+simple utilities for [hmeap][hmeap], a [haskell][hs] parser for+[meapsoft][meap] analysis files. - meapsoft: http://labrosa.ee.columbia.edu/meapsoft/- hmeap: http://slavepianos.org/rd/+illustrate using hmeap with hmatrix, [gnuplot][gnuplot] and+[hsc3][hsc3]. -(c) rohan drape and others, 2007-2011- gpl.2, http://gnu.org/copyleft/- with contributions by stefan kersten- see darcs history for details+[hs]: http://haskell.org/+[meap]: http://labrosa.ee.columbia.edu/meapsoft/+[hsc3]: http://rd.slavepianos.org/?t=hsc3+[hmeap]: http://rd.slavepianos.org/?t=hmeap+[gnuplot]: http://www.gnuplot.info/++© [rohan drape][rd] and others, 2007-2012, [gpl].+with contributions by:++- [stefan kersten][sk]++see the [darcs][darcs] [history][history] for details++[rd]: http://rd.slavepianos.org/+[sk]: http://space.k-hornz.de/+[gpl]: http://gnu.org/copyleft/+[darcs]: http://darcs.net/+[history]: http://rd.slavepianos.org/r/d/darcsweb.cgi?r=hmeap-utils
cmd/browse.hs view
@@ -11,7 +11,7 @@ readDef :: (Read a) => a -> String -> a readDef x s = maybe x id (readMaybe s) -browse :: M.MEAP -> IO ()+browse :: M.MEAP Float -> IO () browse m = do putStr "feature> " i <- fmap (readDef 0) getLine
cmd/play.hs view
@@ -2,85 +2,91 @@ import Data.Function import Data.List import qualified Sound.Analysis.Meapsoft as M-import Sound.OpenSoundControl+import Sound.OSC import Sound.SC3 import System.Environment grain :: UGen -> UGen-grain b = p * e- where 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+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 t) => t -> Double -> Double -> IO ()-mk_grain fd s d =+mk_grain :: (Transport m) => Float -> Float -> m ()+mk_grain s d = let xs = [ ("start", s) , ("dur", d) ]- in send fd (s_new "grain" (-1) AddToTail 1 xs)+ in send (s_new "grain" (-1) AddToTail 1 xs) tone :: UGen-tone = p * e- where 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])+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 t) => t -> Double -> Double -> IO ()-mk_tone fd f d =+mk_tone :: (Transport m) => Float -> Float -> m ()+mk_tone f d = let xs = [ ("freq", f) , ("dur", d) ]- in send fd (s_new "tone" (-1) AddToTail 1 xs)+ in send (s_new "tone" (-1) AddToTail 1 xs) -- (Temporal_Scalar, [Segments], [Freq])-type Spec = (Double, [(Double, Double)], [Double])+type Spec = (Float, [(Float, Float)], [Float])+type Gen_Spec = M.MEAP Float -> Spec -plyr :: Transport t => t -> Spec -> IO ()-plyr _ (_, [], _) = return ()-plyr fd (t, (s,d):xs, f:fs) = do mk_grain fd s d- mk_tone fd f (d * t * 0.25)- pauseThread (d * t)- plyr fd (t, xs, fs)-plyr _ _ = undefined+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 :: FilePath -> FilePath -> (M.MEAP -> Spec) -> IO ()-run_grn sf ff rule = withSC3 g- where g fd = do reset fd- let g0 = out 0 (grain 10)- g1 = out 0 tone- _ <- async fd (b_allocRead 10 sf 0 0)- _ <- async fd (d_recv (synthdef "grain" g0))- _ <- async fd (d_recv (synthdef "tone" g1))- (Right m) <- M.read_meap ff- plyr fd (rule m)+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 -> [Double]+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 -> [Double]+freq_1 :: M.MEAP Float -> [Float] freq_1 = col "AvgFreqSimple" -- forwards-rule_1 :: M.MEAP -> Spec+rule_1 :: Gen_Spec rule_1 c = (0.75, M.segments_l c, freq_1 c) -freq_2 :: M.MEAP -> [Double]+freq_2 :: M.MEAP Float -> [Float] freq_2 = col "AvgSpecCentroid" -- backwards-rule_2 :: M.MEAP -> Spec+rule_2 :: Gen_Spec rule_2 c = (0.5, reverse (M.segments_l c), reverse (freq_2 c)) -gen_order_1 :: M.MEAP -> String -> [Int]+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@@ -89,7 +95,7 @@ apply_order :: [Int] -> [a] -> [a] apply_order o xs = map (\i -> xs !! i) o -srt_rule :: String -> (M.MEAP -> [Double]) -> M.MEAP -> Spec+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)@@ -97,28 +103,28 @@ in (0.5, s, f) -- sorted by segment length (ascending)-rule_3 :: M.MEAP -> Spec+rule_3 :: Gen_Spec rule_3 = srt_rule "chunk_length" freq_1 -- sorted by frequency (ascending)-rule_4 :: M.MEAP -> Spec+rule_4 :: Gen_Spec rule_4 = srt_rule "AvgFreqSimple" freq_1 -- sorted by spectral centroid (ascending)-rule_5 :: M.MEAP -> Spec+rule_5 :: Gen_Spec rule_5 = srt_rule "AvgSpecCentroid" freq_2 -- sorted by spectral stability (ascending)-rule_6 :: M.MEAP -> Spec+rule_6 :: Gen_Spec rule_6 = srt_rule "SpectralStability" freq_2 -gen_sel_1 :: M.MEAP -> String -> (Double -> Bool) -> [Int]+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 -> (Double -> Bool) -> (M.MEAP -> [Double]) -> M.MEAP -> Spec+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)@@ -126,11 +132,11 @@ in (0.5, s, f) -- filtered by frequency (> 600)-rule_7 :: M.MEAP -> Spec+rule_7 :: Gen_Spec rule_7 = sel_rule "AvgFreqSimple" (> 600) freq_1 -- filtered by spectral centroid (> 1200)-rule_8 :: M.MEAP -> Spec+rule_8 :: Gen_Spec rule_8 = sel_rule "AvgSpecCentroid" (> 1200) freq_2 interleave :: [a] -> [a] -> [a]@@ -139,7 +145,7 @@ interleave (a:as) (b:bs) = a : b : interleave as bs -- interleaving of rules 4 & 5-rule_9 :: M.MEAP -> Spec+rule_9 :: Gen_Spec rule_9 m = let (_, s4, f4) = rule_4 m (_, s5, f5) = rule_5 m@@ -149,34 +155,37 @@ reverse_spec (t, x, f) = (t, reverse x, reverse f) -- reverse of rule 9-rule_10 :: M.MEAP -> Spec+rule_10 :: Gen_Spec rule_10 = reverse_spec . rule_9 -scale_start_only :: Double -> Spec -> Spec-scale_start_only n (t, x, f) = (t, map g x, f)- where g (s, d) = (s * n, d)+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 :: M.MEAP -> Spec+rule_11 :: Gen_Spec rule_11 = (scale_start_only 0.5) . rule_10 -scale_dur_only :: Double -> Spec -> Spec-scale_dur_only n (t, x, f) = (t, map g x, f)- where g (s, d) = (s, d * n)+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 :: M.MEAP -> Spec+rule_12 :: Gen_Spec rule_12 = (scale_dur_only 0.5) . rule_7 -fix_dur :: Double -> Spec -> Spec-fix_dur n (t, x, f) = (t, map g x, f)- where g (s, _) = (s, n)+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 :: M.MEAP -> Spec+rule_13 :: Gen_Spec rule_13 = (fix_dur 0.25) . rule_7 -rules :: [M.MEAP -> Spec]+rules :: [Gen_Spec] rules = [ rule_1 , rule_2 , rule_3@@ -198,4 +207,4 @@ let [w_fn, f_fn, r] = a rn = read r - 1 unless (rn >= 0 && rn < length rules) (error "unknown rule")- run_grn w_fn f_fn ( rules !! rn )+ withSC3 (run_grn w_fn f_fn ( rules !! rn ))
hmeap-utils.cabal view
@@ -1,10 +1,10 @@ Name: hmeap-utils-Version: 0.11+Version: 0.14 Synopsis: Haskell Meapsoft Parser Utilities Description: Utilities related to the hmeap parser. License: GPL Category: Sound-Copyright: Rohan Drape and others, 2007-2011+Copyright: Rohan Drape and others, 2007-2013 Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental@@ -18,23 +18,23 @@ Executable hmeap-browse Main-Is: cmd/browse.hs- Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.11.*,parsec+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.14.*,parsec Executable hmeap-parser Main-Is: cmd/parser.hs- Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.11.*,parsec+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.14.*,parsec Executable hmeap-play Main-Is: cmd/play.hs- Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.11.*,hosc==0.11.*,hsc3==0.11.*,parsec+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmeap==0.14.*,hosc==0.14.*,hsc3==0.14.*,parsec Executable hmeap-plot Main-Is: cmd/plot.hs- Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,gnuplot,hmatrix,hmeap==0.11.*,parsec+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,gnuplot,hmatrix,hmeap==0.14.*,parsec Executable hmeap-stat Main-Is: cmd/stat.hs- Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmatrix,hmeap==0.11.*,parsec+ Build-Depends: array,base==4.*,bytestring,bytestring-lexing,delimited-text >= 0.1.0,hmatrix,hmeap==0.14.*,parsec Source-Repository head Type: darcs