diff --git a/README b/README --- a/README +++ b/README @@ -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/ diff --git a/Sound/SC3/Auditor.hs b/Sound/SC3/Auditor.hs --- a/Sound/SC3/Auditor.hs +++ b/Sound/SC3/Auditor.hs @@ -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' diff --git a/Sound/SC3/Auditor/CT.hs b/Sound/SC3/Auditor/CT.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Auditor/CT.hs @@ -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 diff --git a/Sound/SC3/Auditor/FCD.hs b/Sound/SC3/Auditor/FCD.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Auditor/FCD.hs @@ -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)])]) diff --git a/Sound/SC3/Auditor/PF.hs b/Sound/SC3/Auditor/PF.hs --- a/Sound/SC3/Auditor/PF.hs +++ b/Sound/SC3/Auditor/PF.hs @@ -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)])) -} diff --git a/Sound/SC3/Auditor/Smplr.hs b/Sound/SC3/Auditor/Smplr.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Auditor/Smplr.hs @@ -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) diff --git a/Sound/SC3/Auditor/TR808.hs b/Sound/SC3/Auditor/TR808.hs --- a/Sound/SC3/Auditor/TR808.hs +++ b/Sound/SC3/Auditor/TR808.hs @@ -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 diff --git a/hsc3-auditor.cabal b/hsc3-auditor.cabal --- a/hsc3-auditor.cabal +++ b/hsc3-auditor.cabal @@ -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