hsc3-auditor 0.14 → 0.15

raw patch · 8 files changed

+508/−118 lines, 8 filesdep +hsc3-sf-hsndfiledep ~hmtdep ~hoscdep ~hsc3PVP ok

version bump matches the API change (PVP)

Dependencies added: hsc3-sf-hsndfile

Dependency ranges changed: hmt, hosc, hsc3

API changes (from Hackage documentation)

Files

• README +1/−1
• Sound/SC3/Auditor.hs +50/−84
• Sound/SC3/Auditor/CT.hs +52/−0
• Sound/SC3/Auditor/FCD.hs +190/−0
• Sound/SC3/Auditor/PF.hs +38/−20
• Sound/SC3/Auditor/Smplr.hs +158/−0
• Sound/SC3/Auditor/TR808.hs +8/−6
• hsc3-auditor.cabal +11/−7

@@ -4,7 +4,7 @@ A simple-minded [haskell][hs] [supercollider][sc3] auditioner for music structures. -© [rohan drape][rd], 2010-2013, [gpl][gpl].+© [rohan drape][rd], 2010-2014, [gpl][gpl].  [hs]: http://haskell.org/ [sc3]: http://audiosynth.com/

@@ -2,133 +2,99 @@ module Sound.SC3.Auditor where  import Data.List {- base -}+import System.FilePath {- filepath -}++import qualified Music.Theory.Time.Seq as T {- hmt -} import Sound.OSC {- hosc -} import Sound.SC3 {- hsc3 -} --- | Amplitude+import qualified Sound.SC3.Auditor.Smplr as A++-- | Amplitude (linear gain) type Amplitude = Double --- | Index+-- | Buffer index. type Index = Int  -- | Number of channels type NC = Int -type Note = (Index,Amplitude)+-- | 'Index' and 'Amplitude'+data Note = Note {note_index :: Index+                 ,note_amplitude :: Amplitude}+            deriving (Eq,Ord,Show)  -- | Chord type Chord = [Note] --- | Duration-type Duration = Double---- | Start time-type Start_Time = Double---- | 'Start_Time' and 'Chord'.-type P = (Start_Time,Chord)---- | Set of 'P'.-type PP = [P]- -- | Function to generate the set of 'OSC' commands required to load -- the set of 'Index'ed files. type Sample_Loader = [Index] -> [Message] -to_p :: (a -> Index,a -> Amplitude) -> (Start_Time,[a]) -> P+-- | Shorthand+type PP = T.Tseq Time Chord++to_p :: (a -> Index,a -> Amplitude) -> (Time,[a]) -> (Time,Chord) to_p (i,a) (t,x) =-    let f e = (i e,a e)+    let f e = Note (i e) (a e)     in (t,map f x) -note_index :: Note -> Index-note_index = fst--note_amplitude :: Note -> Amplitude-note_amplitude = snd- chord_indices :: Chord -> [Index]-chord_indices = map fst--p_start_time :: P -> Start_Time-p_start_time = fst--p_chord :: P -> Chord-p_chord = snd+chord_indices = map note_index -pp_start_times :: PP -> [Start_Time]-pp_start_times = map p_start_time+pp_start_times :: T.Tseq Time Chord -> [Time]+pp_start_times = map fst -pp_chords :: PP -> [Chord]-pp_chords = map p_chord+pp_chords :: T.Tseq Time Chord -> [Chord]+pp_chords = map snd --- | Start time of last 'P' at 'PP'.-pp_duration :: PP -> Duration-pp_duration = p_start_time . last+-- | Start time of last element (this is not the same as 'tseq_dur').+pp_duration :: T.Tseq Time Chord -> Time+pp_duration = fst . last --- | The set of 'Index' referenced to by 'PP'.-pp_indices :: PP -> [Index]-pp_indices = nub . sort . concatMap (chord_indices . p_chord)+-- | The set (unique, sorted) of indices referenced.+pp_indices :: T.Tseq Time Chord -> [Index]+pp_indices = nub . sort . concatMap (chord_indices . snd)  chd_osc :: Chord -> [Message] chd_osc =-  let f n = s_new "s" (-1) AddToTail 1 [("b",fromIntegral (note_index n))-                                       ,("a",note_amplitude n)]+  let f n = s_new "smplr" (-1) AddToTail 1 [("bufnum",fromIntegral (note_index n))+                                           ,("amp",note_amplitude n)]   in map f -p_osc :: P -> Bundle+p_osc :: (Time,Chord) -> Bundle p_osc (t,c) = bundle t (chd_osc c) --- | Generate set of 'OSC' given 'NC', 'Sample_Loader' and 'PP'.-pp_nrt :: NC -> Sample_Loader -> PP -> NRT+-- | Generate 'NRT' given 'NC', 'Sample_Loader' and 'PP'.+pp_nrt :: NC -> Maybe Sample_Loader -> T.Tseq Time Chord -> NRT pp_nrt nc ld pp =     let b = bundle         ix = pp_indices pp         group_zero = g_new [(1, AddToTail, 0)]-        sc_init = let h = b 0 [group_zero,instr_osc nc]-                  in h : map (b 0 . return) (ld ix)+        sc_init = let h = b 0 [group_zero,A.smplr_nc_osc nc]+                  in h : maybe [] (\ld' -> map (b 0 . return) (ld' ix)) ld         sc_end = [b (pp_duration pp + 12) [g_freeAll [1]]]   in NRT (sc_init ++ map p_osc pp ++ sc_end)  -- | Variant of 'pp_osc' that writes @NRT@ score to named file using -- 'writeNRT'.-pp_nrt_write :: FilePath -> NC -> Sample_Loader -> PP -> IO ()-pp_nrt_write nm nc ld = writeNRT nm . pp_nrt nc ld---- * Instrument--instr_osc :: NC -> Message-instr_osc nc = d_recv (synthdef "s" (smplr nc))--smplr :: NC -> UGen-smplr nc =-    let b = control KR "b" 0 -- buffer-        a = control KR "a" 1 -- amplitude-        o = control KR "o" 0 -- output channel-        b_d = bufDur KR b-        b_r = bufRateScale KR b-        c = envCoord [(0,1),(1,1)] b_d 1 EnvLin-        e = envGen KR 1 a 0 1 RemoveSynth c-    in out o (playBuf nc AR b b_r 1 0 NoLoop DoNothing * e)---- * Audition+pp_nrt_write :: FilePath -> NC -> Sample_Loader -> T.Tseq Time Chord -> IO ()+pp_nrt_write nm nc ld = writeNRT nm . pp_nrt nc (Just ld) --- | Load sample playback instrument to @scsynth@ at 'Transport'.-au_load_instr :: Transport m => NC -> m ()-au_load_instr nc = do-  _ <- async (instr_osc nc)-  return ()+-- | 'audition' of 'pp_nrt' (two channels, no loader).+pp_audition :: T.Tseq Time Chord -> IO ()+pp_audition = audition . pp_nrt 2 Nothing -au_chd :: Transport m => (Chord,Duration) -> m ()-au_chd (c,d) = do-  --putStrLn ("au_chd: " ++ show d)-  mapM_ send (chd_osc c)-  pauseThread d+-- * Loader -pp_st_to_dur :: PP -> [(Chord,Duration)]-pp_st_to_dur pp =-    let (t,x) = (pp_start_times pp,pp_chords pp)-    in zip x (zipWith (-) (drop 1 t) t ++ [0])+-- | Given 0-indexed list of channels to read, and an ordered sequence+-- of filenames make 'Sample_Loader'.+au_loader :: [Int] -> [String] -> Sample_Loader+au_loader ch nm =+    let f i = b_allocReadChannel i (nm !! i) 0 0 ch+    in map f --- | Audition 'PP' at @scsynth@ instance at 'Transport'.-pp_audition :: (Transport m) => PP -> m ()-pp_audition pp = mapM_ au_chd (pp_st_to_dur pp)+-- | Variant where all files are in the same directory, so given as+-- directory and file list.+au_loader_dir :: [Int] -> FilePath -> [FilePath] -> Sample_Loader+au_loader_dir ch dir nm = let nm' = map (dir </>) nm in au_loader ch nm'

@@ -0,0 +1,52 @@+-- | Functions to generate a click track from a metric structure.+module Sound.SC3.Auditor.CT where++import Data.List {- base -}++import qualified Music.Theory.Duration.CT as T {- hmt -}+import qualified Music.Theory.Time.Seq as T {- hmt -}++import Sound.SC3 {- hsc3 -}++import qualified Sound.SC3.Auditor as A {- hsc3-auditor -}++type CT_SF = (FilePath,A.Index,A.Amplitude)+type CT_Node_SF = T.CT_Node -> [CT_SF]++ct_note :: CT_SF -> A.Note+ct_note (_,i,j) = A.Note i j++ct_realise :: CT_Node_SF -> T.Dseq Double T.CT_Node -> T.Tseq Double [CT_SF]+ct_realise ix_fn = T.tseq_map ix_fn . T.dseq_to_tseq 0 T.CT_End++ct_normalise_sf :: [CT_SF] -> [(A.Index,FilePath)]+ct_normalise_sf = nub . sort . map (\(fn,ix,_) -> (ix,fn))++ct_sf_seq :: [(A.Index,FilePath)] -> [FilePath]+ct_sf_seq sq =+    let (ix,fn) = unzip sq+    in if ix `isPrefixOf` [0..]+       then fn+       else error "ct_sf_seq"++ct_auditor :: CT_Node_SF -> T.Dseq Double T.CT_Node -> ([FilePath],A.PP)+ct_auditor ix_fn sq =+    let sf = ct_realise ix_fn sq+        pp = T.tseq_map (map ct_note) sf+        fn_set = ct_sf_seq (ct_normalise_sf (concatMap snd sf))+    in (fn_set,pp)++ct_ldr :: [FilePath] -> A.Sample_Loader+ct_ldr = A.au_loader [0]++ct_sc :: CT_Node_SF -> T.CT -> NRT+ct_sc ix_fn ct =+    let (rq,n) = T.ct_count ct+        pre = T.ct_leadin (rq,fromRational (T.ct_tempo0_err ct),n)+        (fn_set,pp) = ct_auditor ix_fn (pre ++ T.ct_dseq ct)+    in A.pp_nrt 1 (Just (ct_ldr fn_set)) pp++ct_render :: FilePath -> FilePath -> CT_Node_SF -> T.CT -> IO ()+ct_render osc_fn wav_fn ix_fn =+    nrt_render_plain (osc_fn,wav_fn,1,48000,PcmInt16) .+    ct_sc ix_fn

@@ -0,0 +1,190 @@+{-| Farfisa (electronics)++Recordings of FARFISA COMPACT DUO from B3 to D#6.++Registrations flute8, oboe8, trumpet8, strings8.++With and without vibrato.++Files are each recorded in one pass, metronome m=54, measure=6/4.++flute8, oboe8, trumpet8 were recorded together and balance is natural.++strings8 was recorded later, balance is below.++strings8 ought to balance with trumpet8.++-}+module Sound.SC3.Auditor.FCD where++import Data.List {- base -}+import Data.Maybe {- base -}+import System.FilePath {- filepath -}++import qualified Music.Theory.List as T+import qualified Music.Theory.Pitch as T++import Sound.OSC {- hosc -}+import Sound.SC3 {- hsc3 -}++import qualified Sound.File.HSndFile as F {- hsc3-sf-hsndfile -}++import qualified Sound.SC3.Auditor.Smplr as A++fcd_dir :: FilePath+fcd_dir = "/home/rohan/data/audio/instr/farfisa/aad"++-- | There are four separate registrations (three used in aad).+fcd_registrations_plain :: [String]+fcd_registrations_plain = ["flute8","oboe8","trumpet8","strings8"]++-- | Each has a vibrato variant.+fcd_registrations_vib :: [String]+fcd_registrations_vib = map (++ "-vib") fcd_registrations_plain++-- | Making eight registrations in total.+fcd_registrations :: [String]+fcd_registrations = T.interleave fcd_registrations_plain fcd_registrations_vib++-- | Having indices @0@ through @7@.+fcd_registrations_ix :: [Int]+fcd_registrations_ix = [0..7]++-- | Stored as @flac@.+fcd_format :: String+fcd_format = "flac"++-- | The files of the recordings of the eight registrations.+fcd_fnames :: [FilePath]+fcd_fnames =+    let f k = fcd_dir </> k <.> fcd_format+    in map f fcd_registrations++-- | 'header' of 'fcd_fnames.+--+-- > h <- fcd_hdr+-- > length h == 8+-- > map frameCount h+fcd_hdr :: IO [F.Header]+fcd_hdr = mapM F.header fcd_fnames++-- | The recorded duration for each tone (in seconds), ie. ts=6/4 at q=54.+--+-- > fcd_sample_dur == 6 + 2/3+fcd_sample_dur :: Fractional n => n+fcd_sample_dur = 20/3++-- | Range (inclusive) of recorded tones.+fcd_range :: (T.OctPC,T.OctPC)+fcd_range = ((3,11),(6,3))++bimap1 :: (t -> u) -> (t, t) -> (u, u)+bimap1 f (p,q) = (f p,f q)++-- | As midi note numbers.+fcd_range_midi :: Num n => (n,n)+fcd_range_midi = bimap1 (fromIntegral . T.octpc_to_midi) fcd_range++-- | All of the recorded midi note numbers.+--+-- > length fcd_gamut_midi == 29+fcd_gamut_midi :: (Enum n,Num n) => [n]+fcd_gamut_midi = let (l,r) = fcd_range_midi in [l .. r]++-- | (note-predicate,sf-header,sf-name)+type SF_LD = (Int -> Bool,F.Header,FilePath)++-- | The odd form allows selective loading based on /m/, where the+-- buffer numbers are as if all were loaded.+--+-- st = start time (sec.), du = duration (sec.), b = buffer-id, m = midi-note number+sf_load_msg :: SF_LD -> Double -> Double -> Int -> Int -> Maybe Message+sf_load_msg (sel_f,hdr,fn) st du b m =+  let nf = F.frameCount hdr+      sr = F.sampleRate hdr+      nc = F.channelCount hdr+      st' = round (st * sr)+      du' = round (du * sr)+  in if nc /= 1 || nf < st' + du'+     then error "sf_load: not mono or out of range"+     else if sel_f m+          then Just (b_allocRead b fn st' du')+          else Nothing++-- k = degree (number of allocations), du = duration of each allocation+sf_load_seq_msg :: SF_LD -> Int -> Double -> (Double,Double) -> Int -> [Message]+sf_load_seq_msg opt k du (st_d,en_d) b =+    let st = map (+ st_d) [du, du * 2 ..]+        du' = map (subtract en_d) (repeat du)+        m = zipWith4 (sf_load_msg opt) st du' [b .. b + k - 1] fcd_gamut_midi+    in catMaybes m++-- > m <- fmap (fcd_load_seq_msg fcd_sel_f 0) fcd_hdr+-- > map length m == replicate 8 (length pitch_collection_midi)+-- > withSC3 (mapM_ async (concat m))+--+-- > m' <- fmap (fcd_load_seq_msg (const True) 0) fcd_hdr+-- > withSC3 (mapM_ async (concat m'))+fcd_load_seq_msg :: (Int -> Bool) -> Int -> [F.Header] -> [[Message]]+fcd_load_seq_msg sel_f b0 h =+  let f hdr fn = sf_load_seq_msg (sel_f,hdr,fn) 29 (20/3) (0.25,0.25)+      b = [b0,b0 + 29 ..]+  in zipWith3 f h fcd_fnames b++-- > fcd_load_sel (const True) 0+fcd_load_sel :: (Int -> Bool) -> Int -> IO ()+fcd_load_sel sel_f b0 = do+  m <- fmap (fcd_load_seq_msg sel_f b0) fcd_hdr+  withSC3 (mapM_ async (concat m))++-- | Here /k/ is the set of registrations to load.+fcd_load_all_msg :: Int -> [Int] -> IO [Message]+fcd_load_all_msg b0 k = do+  h <- fcd_hdr+  let h' = map (h !!) k+      msg = fcd_load_seq_msg (const True) b0 h'+  return (concat msg)++-- > fcd_load_all 0 [0]+fcd_load_all :: Int -> [Int] -> IO ()+fcd_load_all b0 k = do+  m <- fcd_load_all_msg b0 k+  withSC3 (mapM_ async m)++-- * Smplr++-- > range_degree fcd_range_midi == 29+range_degree :: Num a => (a,a) -> a+range_degree (l,r) = r - l + 1++-- ch = channel assignment mode, nid = node id, b0 = buffer zero, m =+-- midi note number, dt = detune (cents), du = duration, g = gain, n =+-- registration, bus = output bus, grp = group to allocate node at, p2+-- = further synthesis parameters+--+-- > let opt = (fcd_range_midi,"pn",-1,0,(0.05,0.15),0,1,[]) :: A.SMPLR_OPT+-- > withSC3 (send (fcd_smplr opt 0 (60,0) (Just 2) 1))+--+-- > withSC3 (send (fcd_smplr opt 0 (30,0) Nothing 1))+-- > withSC3 (send (n_set1 (-1) "gate" 0))+fcd_smplr :: A.SMPLR_OPT -> Int -> (Int,Double) -> Maybe Double -> Double -> Message+fcd_smplr (rng,ch,nid,b0,(aT,rT),bus,grp,p2) n (m,dt) du g =+    let n' = n `mod` 6+        b0' = b0 + range_degree rng * n'+        -- level adjustments, flute8 is quiet etc.+        g' = g * case n' of+                   0 -> 4+                   1 -> 4+                   2 -> 1+                   3 -> 1+                   4 -> 0.5+                   5 -> 0.5+                   _ -> error "fcd_smplr: level adjustment"+    in A.smplr_msg (rng,ch,nid,b0',(aT,rT),bus,grp,p2) (m,dt) du g'++fcd_init :: Int -> [Int] -> IO [Bundle]+fcd_init b0 k = do+  let f = bundle 0 . return+      sy = A.smplr_recv_all_msg+  ld <- fcd_load_all_msg b0 k+  return (map f sy ++ map f ld ++ [f (g_new [(1,AddToTail,0)])])

@@ -1,55 +1,73 @@ -- | /Bosendorfer/ piano sample library based auditioner. module Sound.SC3.Auditor.PF where +import System.FilePath {- filepath -}+ import qualified Music.Theory.Pitch as T {- hmt -}+import qualified Music.Theory.Time.Seq as T {- hmt -} import Sound.OSC {- hosc -} import Sound.SC3 {- hsc3 -}-import Sound.SC3.Auditor-import System.FilePath {- filepath -} +import qualified Sound.SC3.Auditor as A+import qualified Sound.SC3.Auditor.Smplr as A+ -- * Bosendorfer +pf_dir :: FilePath+pf_dir = "/home/rohan/data/audio/instr/bosendorfer/"+ -- | 'Derive_Index' function for /Bosendorfer/ sample set.  The offset -- from buffer number to midi note number, adjusted for by this -- function, is @24@.-bosendorfer_octpc_to_index :: T.OctPC -> Index+bosendorfer_octpc_to_index :: T.OctPC -> A.Index bosendorfer_octpc_to_index (o,pc) = fromIntegral (o * 12 + pc + 12 - 24)  -- | Convert set of 'T.OctPC' based 'P' to 'PP' with appropriate -- 'Derive_Index' function.-for_pf :: [(Start_Time,[(T.OctPC,Amplitude)])] -> PP-for_pf = map (to_p (bosendorfer_octpc_to_index.fst,snd))+for_pf :: T.Tseq Time [(T.OctPC,A.Amplitude)] -> T.Tseq Time A.Chord+for_pf = map (A.to_p (bosendorfer_octpc_to_index . fst,snd)) +--pf_from_midi_wseq =+ note_names :: [String] note_names = ["C", "C#", "D", "D#", "E", "F"              ,"F#", "G", "G#", "A", "A#", "B"] +-- > length file_names == 84 file_names :: [String] file_names = [(n ++ show o) <.> "aif" | o <- [1::Int .. 7], n <- note_names] -bosendorfer_osc :: FilePath -> (String, Int) -> Message-bosendorfer_osc d (fn,i) = b_allocRead i (d </> fn) 0 0+bosendorfer_osc :: [Int] -> FilePath -> (String,Int) -> Message+bosendorfer_osc ch d (fn,i) = b_allocReadChannel i (d </> fn) 0 0 ch  -- | Generate set of 'OSC' messages to load /Bosendorfer/ sample -- library.-bosendorfer_set_osc :: FilePath -> [Message]-bosendorfer_set_osc d = map (bosendorfer_osc d) (zip file_names [0..])+bosendorfer_set_osc :: [Int] -> FilePath -> Int -> [Message]+bosendorfer_set_osc ch d b0 = map (bosendorfer_osc ch d) (zip file_names [b0..])  -- | Variant of 'bosendorfer_set_osc' to load required subset of library.-bosendorfer_subset_osc :: FilePath -> Sample_Loader-bosendorfer_subset_osc d ix =-    let nm = filter ((`elem` ix) . snd) (zip file_names [0..])-    in map (bosendorfer_osc d) nm+bosendorfer_subset_osc :: [Int] -> FilePath -> Int -> A.Sample_Loader+bosendorfer_subset_osc ch d b0 ix =+    let nm = filter ((`elem` ix) . snd) (zip file_names [b0..])+    in map (bosendorfer_osc ch d) nm  -- | Send 'OSC' set given by 'bosendorfer_set_osc' to @scsynth@ at -- 'Transport'.-au_load_bosendorfer_set :: Transport m => FilePath -> m ()-au_load_bosendorfer_set d = mapM_ async (bosendorfer_set_osc d)+au_load_bosendorfer_set :: Transport m => [Int] -> FilePath -> Int -> m ()+au_load_bosendorfer_set ch d b0 = mapM_ async (bosendorfer_set_osc ch d b0) +-- > withSC3 (mapM_ sendBundle (pf_init "008" [0,1] 0))+pf_init :: String -> [Int] -> Int -> [Bundle]+pf_init ly ch b0 =+    let f = bundle 0 . return+        sy = A.smplr_recv_all_msg+        ld = bosendorfer_set_osc ch (pf_dir </> ly) b0+    in map f sy ++ map f ld ++ [f (g_new [(1,AddToTail,0)])]+ {--let d = "/home/rohan/disk/proudhon/data/bosendorfer/008/"-bosendorfer_set_osc d-withSC3 (au_load_bosendorfer_set d)-withSC3 (au_load_instr 2)-withSC3 (\fd -> send fd (s_new "s" (-1) AddToTail 1 [("b", 60-24)]))+let d = "/home/rohan/data/audio/instr/bosendorfer/008/"+bosendorfer_set_osc [0,1] d 0+withSC3 (au_load_bosendorfer_set [0,1] d 0)+withSC3 (async (A.instr_osc 2))+withSC3 (send (s_new "s" (-1) AddToTail 1 [("b", 60-24)])) -}

@@ -0,0 +1,158 @@+-- | Auditor sampler synthdef.+module Sound.SC3.Auditor.Smplr where++import qualified Music.Theory.Tuning as T {- hmt -}++import Sound.OSC {- hosc -}+import Sound.SC3 {- hsc3 -}++-- | If a note is not in range, shift until it is in range and set playback rate.+--+-- map (fold_midi (59,87)) [(1,50.5),(1,60.5),(1,90.5)] == [(0.5,62.5),(1.0,60.5),(2.0,78.5)]+fold_midi :: (Ord n,Num n,Num r,Fractional r) => (n,n) -> (r,n) -> (r,n)+fold_midi (l,r) (rt,mn) =+    if mn < l+    then fold_midi (l,r) (rt / 2,mn + 12)+    else if mn > r+            then fold_midi (l,r) (rt * 2,mn - 12)+            else (rt,mn)++type Param = [(String,Double)]++-- | Right biased+param_merge :: Param -> Param -> Param+param_merge p1 p2 =+    let p2_k = map fst p2+        p1' = filter (\(k,_) -> k `notElem` p2_k) p1+    in p1' ++ p2++{- | Trivial file playback instrument.  The /rdelay/ parameter sets+the maximum pre-delay time (in seconds), each instance is randomly+pre-delayed betwee zero and the indicated time.  The /ramplitude/+parameter sets the maximum amplitude offset of the /amp/ parameter,+each instance is randomly amplified between zero and the indicated+value.++If /use_gate/ is 'True' the synth ends either when the sound file+ends or the gate closes, else there is a /sustain/ parameter and a+linear envelope with a decay time of /decay/ is applied.++If /pan/ is 'True' the sampler pans according to the @pan@+parameter, else it writes directly to @bus@.++> let {u = [False,True]; opt = [(a,b) | a <- u, b <- u]}+> in withSC3 (mapM_ async (map (d_recv . smplr) opt))++> import Sound.SC3.Lang.Control.Event+> import Sound.SC3.Lang.Pattern.ID++> audition (pbind [(K_instr,psynth (smplr (True,True)))+>                 ,(K_param "bufnum",pseries 0 1 (29 * 3))+>                 ,(K_param "attack",0.25)+>                 ,(K_param "decay",0.15)+>                 ,(K_dur,0.35)])++> audition (pbind [(K_instr,psynth (smplr (True,True)))+>                 ,(K_param "bufnum",pwhitei 'a' 0 (6 * 6) inf)+>                 ,(K_param "startpos",0.15 * 48000)+>                 ,(K_param "attack",0.15)+>                 ,(K_amp,pwhite 'b' 0.15 0.65 inf)+>                 ,(K_param "pan",pwhite 'c' (-1) 1 inf)+>                 ,(K_dur,pwhite 'd' 0.15 1.65 inf)])++-}+smplr :: (Bool,Bool) -> Synthdef+smplr (use_pan,use_gate) =+    let b = control KR "bufnum" 0+        l = control KR "pan" 0+        a = control KR "amp" 0.1+        r = control KR "rate" 1+        m = control KR "rdelay" 0+        v = control KR "ramplitude" 0+        w = control KR "rpan" 0+        u = control KR "attack" 0+        y = control KR "decay" 0.5+        g = control KR "gate" 1+        sp = control KR "startpos" 0 -- frames+        bus = control KR "bus" 0+        r' = bufRateScale KR b * r+        lp = if use_gate then Loop else NoLoop+        p = playBuf 1 AR b r' 1 sp lp DoNothing+        e = if use_gate+            then envGen KR g 1 0 1 RemoveSynth (envASR u 1 y EnvSin)+            else let sus = control KR "sustain" 1+                 in envGen KR 1 1 0 1 RemoveSynth (envLinen u (sus - u - y) y 1)+        d = delayC (p * e) m (rand 'a' 0 m)+        s = d * (a + rand 'b' 0 v)+        o = out bus (if use_pan then pan2 s (l + rand 'c' (-w) w) 1 else s)+        nm = if use_gate then "smplr-gt" else "smplr-du"+        nm' = nm ++ if use_pan then "-pn" else "-ch"+    in synthdef nm' o++-- > mcons (Just 0) [1..3] == [0..3]+mcons :: Maybe a -> [a] -> [a]+mcons e l = maybe l (: l) e++-- | Sampler options, (rng,ch,nid,b0,(aT,rT),bus,grp,p2)+--+-- ch = channel assignment mode, nid = node id, b0 = buffer zero, aT =+-- attack time, rT = release time, bus = output bus, grp = group to+-- allocate node at, p2 = further synthesis parameters+type SMPLR_OPT = ((Int,Int),String,Int,Int,(Double,Double),Int,Int,Param)++-- | Make @smplr@ control 'Message'.+--+-- m = midi note number, dt = detune (cents), du = duration, g = gain,+smplr_msg :: SMPLR_OPT -> (Int,Double) -> Maybe Double -> Double -> Message+smplr_msg (rng,ch,nid,b0,(aT,rT),bus,grp,p2) (m,dt) du g =+    let (r,m') = fold_midi rng (1,m)+        r' = r * T.cents_to_ratio dt+        z = fst rng+        i = m' - z+        b = b0 + i+        sus = fmap (\du' -> ("sustain",realToFrac du')) du+        p1 = [("bufnum",fromIntegral b)+             ,("rate",r')+             ,("amp",g)+             ,("attack",aT) -- 0.05+             ,("decay",rT) -- 0.15+             ,("rdelay",0.0015)+             ,("ramplitude",g * dbAmp (-15))+             ,("bus",fromIntegral bus)+             ,("startpos",0) -- frames+             ]+        nm = maybe "smplr-gt" (const "smplr-du") du+        nm' = nm ++ "-" ++ ch+    in s_new nm' nid AddToHead grp (mcons sus (param_merge p1 p2))++-- | 'd_recv' messages for all smplr variants.+smplr_recv_all_msg :: [Message]+smplr_recv_all_msg =+    let u = [False,True]+        opt = [(a,b) | a <- u, b <- u]+    in map (d_recv . smplr) opt++-- | Load all smplr variants.+smplr_load_all :: IO ()+smplr_load_all = withSC3 (mapM_ async smplr_recv_all_msg)++-- * NC++-- > withSC3 (async (smplr_nc_osc 2))+smplr_nc_osc :: Int -> Message+smplr_nc_osc nc = d_recv (synthdef "smplr" (smplr_nc nc))++-- > smplr_nc_load 2+smplr_nc_load :: Int -> IO Message+smplr_nc_load nc = withSC3 (async (smplr_nc_osc nc))++smplr_nc :: Int -> UGen+smplr_nc nc =+    let b = control KR "bufnum" 0 -- buffer+        a = control KR "amp" 1 -- amplitude+        o = control KR "bus" 0 -- output channel+        b_d = bufDur KR b+        b_r = bufRateScale KR b+        c = envCoord [(0,1),(1,1)] b_d 1 EnvLin+        e = envGen KR 1 a 0 1 RemoveSynth c+    in out o (playBuf nc AR b b_r 1 0 NoLoop DoNothing * e)

@@ -1,13 +1,15 @@ -- | /TR808/ sample library based auditioner. module Sound.SC3.Auditor.TR808 where -import Data.List-import Data.Maybe+import Data.List {- base -}+import Data.Maybe {- base -}+import System.FilePath {- filepath -}+ import Sound.OSC {- hosc -} import Sound.SC3 {- hsc3 -}-import Sound.SC3.Auditor-import System.FilePath {- filepath -} +import qualified Sound.SC3.Auditor as A+ -- | Enumeration of TR808 instruments. data TR808 = BD -- ^ Bass Drum            | SD -- ^ Snare Drum@@ -138,7 +140,7 @@     in concatMap f tr808_set  -- | Lookup 'Index' for 'TR808' at indicated 'Parameters'.-tr808_index :: TR808 -> Parameters -> Index+tr808_index :: TR808 -> Parameters -> A.Index tr808_index i ps =     let nm = tr808_file_name i ps         err = error "tr808_index"@@ -153,7 +155,7 @@ tr808_alloc_all_osc d = map (tr808_alloc_osc d) (zip tr808_file_map [0..])  -- | Variant of 'tr808_alloc_all_osc' to load required subset of library.-tr808_alloc_subset_osc :: FilePath -> Sample_Loader+tr808_alloc_subset_osc :: FilePath -> A.Sample_Loader tr808_alloc_subset_osc d ix =     let nm = filter ((`elem` ix) . snd) (zip tr808_file_map [0..])     in map (tr808_alloc_osc d) nm

@@ -1,15 +1,15 @@ Name:              hsc3-auditor-Version:           0.14+Version:           0.15 Synopsis:          Haskell SuperCollider Auditor Description:       A simple-minded auditioner for music structures. License:           GPL Category:          Sound-Copyright:         (c) Rohan Drape, 2010-2013+Copyright:         (c) Rohan Drape, 2010-2014 Author:            Rohan Drape Maintainer:        rd@slavepianos.org Stability:         Experimental-Homepage:          http://rd.slavepianos.org/?t=hsc3-auditor-Tested-With:       GHC == 7.6.1+Homepage:          http://rd.slavepianos.org/t/hsc3-auditor+Tested-With:       GHC == 7.8.2 Build-Type:        Simple Cabal-Version:     >= 1.8 @@ -18,12 +18,16 @@ Library   Build-Depends:   base == 4.*,                    filepath,-                   hmt == 0.14.*,-                   hosc == 0.14.*,-                   hsc3 == 0.14.*+                   hmt == 0.15.*,+                   hosc == 0.15.*,+                   hsc3 == 0.15.*,+                   hsc3-sf-hsndfile == 0.15.*   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Sound.SC3.Auditor+                   Sound.SC3.Auditor.CT+                   Sound.SC3.Auditor.FCD                    Sound.SC3.Auditor.PF+                   Sound.SC3.Auditor.Smplr                    Sound.SC3.Auditor.TR808  Source-Repository  head