hsc3-auditor 0.11 → 0.12
raw patch · 5 files changed
+160/−129 lines, 5 filesdep ~hmtdep ~hoscdep ~hsc3
Dependency ranges changed: hmt, hosc, hsc3
Files
- README +11/−7
- Sound/SC3/Auditor.hs +72/−63
- Sound/SC3/Auditor/PF.hs +17/−20
- Sound/SC3/Auditor/TR808.hs +52/−31
- hsc3-auditor.cabal +8/−8
README view
@@ -1,10 +1,14 @@-hsc3-auditor - haskell supercollider auditioner+hsc3-auditor+------------ -A simple-minded auditioner for music structures.+A simple-minded [haskell][hs] [supercollider][sc3] auditioner for+music structures. - http://slavepianos.org/rd/?t=hsc3-auditor- http://haskell.org/- http://audiosynth.com/+© [rohan drape][rd], 2010-2012, [gpl][gpl]. -(c) rohan drape, 2010-2011- gpl, http://gnu.org/copyleft/+[hs]: http://haskell.org/+[sc3]: http://audiosynth.com/+[hsc3]: http://rd.slavepianos.org/?t=hsc3+[hsc3-auditor]: http://slavepianos.org/rd/?t=hsc3-auditor+[rd]: http://rd.slavepianos.org/+[gpl]: http://gnu.org/copyleft/
Sound/SC3/Auditor.hs view
@@ -1,93 +1,102 @@ -- | Auditor functions common to all sample libraries.-module Sound.SC3.Auditor (OCTPC,ST,CHD,DER,AMP,DUR,NC,INDEX- ,P,PP,SAMPLE_LOADER- ,au_load_instr- ,pp_audition- ,pp_duration,pp_indices- ,pp_osc,pp_osc_score) where+module Sound.SC3.Auditor where import Data.List-import qualified Music.Theory.Pitch as T {- hmt -}-import Sound.OpenSoundControl {- hosc -}+import Sound.OSC {- hosc -} import Sound.SC3 {- hsc3 -} --- | Real number-type R = Double---- | (Octave,Pitch-class) pair-type OCTPC = (T.Octave,T.PitchClass)- -- | Amplitude-type AMP = R+type Amplitude = Double -- | Index-type INDEX = Int+type Index = Int -- | Number of channels type NC = Int +type Note = (Index,Amplitude)+ -- | Chord-type CHD a = [(a,AMP)]+type Chord = [Note] -- | Duration-type DUR = R+type Duration = Double -- | Start time-type ST = R---- | (Start-time,Chord) pair-type P a = (ST,CHD a)+type Start_Time = Double --- | Derivation function from 'CHD' element to 'INDEX'.-type DER a = a -> INDEX+-- | 'Start_Time' and 'Chord'.+type P = (Start_Time,Chord) --- | Set of 'P' and associated 'DER' function.-type PP a = (DER a,[P a])+-- | 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] -> [OSC]+-- the set of 'Index'ed files.+type Sample_Loader = [Index] -> [Message] +to_p :: (a -> Index,a -> Amplitude) -> (Start_Time,[a]) -> P+to_p (i,a) (t,x) =+ let f e = (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++pp_start_times :: PP -> [Start_Time]+pp_start_times = map p_start_time++pp_chords :: PP -> [Chord]+pp_chords = map p_chord+ -- | Start time of last 'P' at 'PP'.-pp_duration :: PP a -> DUR-pp_duration = fst . last . snd+pp_duration :: PP -> Duration+pp_duration = p_start_time . last --- | The set of 'INDEX' referenced to by 'PP'.-pp_indices :: PP a -> [INDEX]-pp_indices (f,x) =- let g = nub . sort . concatMap (map (f . fst) . snd)- in map fromIntegral (g x)+-- | The set of 'Index' referenced to by 'PP'.+pp_indices :: PP -> [Index]+pp_indices = nub . sort . concatMap (chord_indices . p_chord) -chd_osc :: DER a -> CHD a -> [OSC]-chd_osc der xs = do- let ns = map (fromIntegral . der . fst) xs- as = map snd xs- f i a = s_new "s" (-1) AddToTail 1 [("b", i),("a",a)]- zipWith f ns as+chd_osc :: Chord -> [Message]+chd_osc =+ let f n = s_new "s" (-1) AddToTail 1 [("b",fromIntegral (note_index n))+ ,("a",note_amplitude n)]+ in map f -p_osc :: DER a -> P a -> OSC-p_osc f (t,c) = bundle (NTPr t) (chd_osc f c)+p_osc :: P -> Bundle+p_osc (t,c) = bundle (NTPr t) (chd_osc c) --- | Generate set of 'OSC' given 'NC', 'SAMPLE_LOADER' and 'PP'.-pp_osc :: NC -> SAMPLE_LOADER -> PP a -> [OSC]-pp_osc nc ld pp =+-- | Generate set of 'OSC' given 'NC', 'Sample_Loader' and 'PP'.+pp_nrt :: NC -> Sample_Loader -> PP -> 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 (NTPr 0) [group_zero,instr_osc nc] in h : map (b (NTPr 0) . return) (ld ix) sc_end = [b (NTPr (pp_duration pp + 12)) [g_freeAll [1]]]- (der,x) = pp- in sc_init ++ map (p_osc der) x ++ sc_end+ in NRT (sc_init ++ map p_osc pp ++ sc_end) -- | Variant of 'pp_osc' that writes @NRT@ score to named file using -- 'writeNRT'.-pp_osc_score :: FilePath -> NC -> SAMPLE_LOADER -> PP a -> IO ()-pp_osc_score nm nc ld = writeNRT nm . pp_osc nc ld+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 -> OSC+instr_osc :: NC -> Message instr_osc nc = d_recv (synthdef "s" (smplr nc)) smplr :: NC -> UGen@@ -104,22 +113,22 @@ -- * Audition -- | Load sample playback instrument to @scsynth@ at 'Transport'.-au_load_instr :: Transport t => NC -> t -> IO ()-au_load_instr nc fd = do- _ <- async fd (instr_osc nc)+au_load_instr :: Transport m => NC -> m ()+au_load_instr nc = do+ _ <- async (instr_osc nc) return () -au_chd :: (Transport t) => t -> DER a -> (CHD a,DUR) -> IO ()-au_chd fd der (c,d) = do- putStrLn ("au_chd: " ++ show d)- mapM_ (send fd) (chd_osc der c)+au_chd :: Transport m => (Chord,Duration) -> m ()+au_chd (c,d) = do+ --putStrLn ("au_chd: " ++ show d)+ mapM_ send (chd_osc c) pauseThread d -d_dx :: [(ST,a)] -> [(a,DUR)]-d_dx xs =- let (t,x) = unzip xs+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]) -- | Audition 'PP' at @scsynth@ instance at 'Transport'.-pp_audition :: (Transport t) => PP a -> t -> IO ()-pp_audition (der,pp) fd = mapM_ (au_chd fd der) (d_dx pp)+pp_audition :: (Transport m) => PP -> m ()+pp_audition pp = mapM_ au_chd (pp_st_to_dur pp)
Sound/SC3/Auditor/PF.hs view
@@ -1,27 +1,24 @@ -- | /Bosendorfer/ piano sample library based auditioner.-module Sound.SC3.Auditor.PF (bosendorfer_set_osc- ,bosendorfer_subset_osc- ,bosendorfer_octpc_to_index- ,for_pf- ,au_load_bosendorfer_set) where+module Sound.SC3.Auditor.PF where -import Sound.OpenSoundControl {- hosc -}+import qualified Music.Theory.Pitch as T {- hmt -}+import Sound.OSC {- hosc -} import Sound.SC3 {- hsc3 -} import Sound.SC3.Auditor import System.FilePath {- filepath -} -- * Bosendorfer --- | 'DER' 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 :: DER OCTPC+-- | '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 (o,pc) = fromIntegral (o * 12 + pc + 12 - 24) --- | Convert set of 'OCTPC' based 'P' to 'PP' with appropriate 'DER'--- function.-for_pf :: [P OCTPC] -> PP OCTPC-for_pf x = (bosendorfer_octpc_to_index,x)+-- | 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)) note_names :: [String] note_names = ["C", "C#", "D", "D#", "E", "F"@@ -30,29 +27,29 @@ file_names :: [String] file_names = [(n ++ show o) <.> "aif" | o <- [1::Int .. 7], n <- note_names] -bosendorfer_osc :: FilePath -> (String, Int) -> OSC+bosendorfer_osc :: FilePath -> (String, Int) -> Message bosendorfer_osc d (fn,i) = b_allocRead i (d </> fn) 0 0 -- | Generate set of 'OSC' messages to load /Bosendorfer/ sample -- library.-bosendorfer_set_osc :: FilePath -> [OSC]+bosendorfer_set_osc :: FilePath -> [Message] bosendorfer_set_osc d = map (bosendorfer_osc d) (zip file_names [0..]) -- | Variant of 'bosendorfer_set_osc' to load required subset of library.-bosendorfer_subset_osc :: FilePath -> SAMPLE_LOADER+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 -- | Send 'OSC' set given by 'bosendorfer_set_osc' to @scsynth@ at -- 'Transport'.-au_load_bosendorfer_set :: Transport t => FilePath -> t -> IO ()-au_load_bosendorfer_set d fd = mapM_ (async fd) (bosendorfer_set_osc d)+au_load_bosendorfer_set :: Transport m => FilePath -> m ()+au_load_bosendorfer_set d = mapM_ async (bosendorfer_set_osc d) {- let d = "/home/rohan/disk/proudhon/data/bosendorfer/008/" bosendorfer_set_osc d withSC3 (au_load_bosendorfer_set d)-withSC3 au_load_instr+withSC3 (au_load_instr 2) withSC3 (\fd -> send fd (s_new "s" (-1) AddToTail 1 [("b", 60-24)])) -}
Sound/SC3/Auditor/TR808.hs view
@@ -3,28 +3,39 @@ import Data.List import Data.Maybe-import Sound.OpenSoundControl {- hosc -}+import Sound.OSC {- hosc -} import Sound.SC3 {- hsc3 -} import Sound.SC3.Auditor import System.FilePath {- filepath -} -- | Enumeration of TR808 instruments.-data TR808 = BD | SD- | LT' | MT | HT- | LC | MC | HC- | RS | CL | CP | MA | CB- | CY | OH | CH+data TR808 = BD -- ^ Bass Drum+ | SD -- ^ Snare Drum+ | LT' -- ^ Low Tom+ | MT -- ^ Mid Tom+ | HT -- ^ High Tom+ | LC -- ^ Low Conga+ | MC -- ^ Mid Conga+ | HC -- ^ High Conga+ | RS -- ^ Rim Shot+ | CL -- ^ Claves+ | CP -- ^ Hand Clap+ | MA -- ^ Maracas+ | CB -- ^ Cow Bell+ | CY -- ^ Cymbal+ | OH -- ^ Open Hi-Hat+ | CH -- ^ Closed Hi-Hat deriving (Eq,Ord,Enum,Bounded,Show) -- | Controller positions to index sample library.-data POSITION = P0 | P1 | P2 | P3 | P4+data Position = P0 | P1 | P2 | P3 | P4 deriving (Eq,Ord,Enum,Bounded,Show) --- | Set of relevant 'POSITION' data.-type PARAMETERS = [POSITION]+-- | Set of relevant 'Position' data.+type Parameters = [Position] --- | Translate 'POSITION' to 'String' encoding in file names.-position_text :: POSITION -> String+-- | Translate 'Position' to 'String' encoding in file names.+position_text :: Position -> String position_text i = case i of P0 -> "00"@@ -82,14 +93,14 @@ RS -> "RIM SHOT" SD -> "SNARE DRUM" --- | Generate 'FilePath' for 'TR808' instrument with indicated 'PARAMETERS'.-tr808_file_name :: TR808 -> PARAMETERS -> FilePath+-- | Generate 'FilePath' for 'TR808' instrument with indicated 'Parameters'.+tr808_file_name :: TR808 -> Parameters -> FilePath tr808_file_name i ps = let i' = tr808_abbrev i </> tr808_abbrev i ps' = concatMap position_text ps in i' ++ ps' <.> "WAV" --- | Generate full set of 'FilePath' for all 'POSITION's of 'TR808'.+-- | Generate full set of 'FilePath' for all 'Position's of 'TR808'. tr808_file_names :: TR808 -> [FilePath] tr808_file_names i = let pp = [minBound .. maxBound]@@ -104,46 +115,56 @@ tr808_file_map :: [FilePath] tr808_file_map = concatMap tr808_file_names [minBound .. maxBound] --- | The set of all 'TR808' data.-tr808_u :: [(TR808,PARAMETERS)]-tr808_u =+-- | The set of all 'Parameters' for a 'TR808' instrument.+tr808_set :: [(TR808,[Parameters])]+tr808_set = let ts = [minBound .. maxBound] ps = [minBound .. maxBound] f t = case tr808_n_param t of- 0 -> [(t,[])]- 1 -> [(t,[p]) | p <- ps]- 2 -> [(t,[p0,p1]) | p0 <- ps, p1 <- ps]- _ -> error "tr808_u"- in concatMap f ts+ 0 -> [[]]+ 1 -> [[p] | p <- ps]+ 2 -> [[p0,p1] | p0 <- ps, p1 <- ps]+ _ -> error "tr808_set"+ in zip ts (map f ts) --- | Lookup 'INDEX' for 'TR808' at indicated 'PARAMETERS'.-tr808_index :: TR808 -> PARAMETERS -> INDEX+-- | Lookup 'tr808_set' for the /n/th variant of 'TR808'.+tr808_variant :: TR808 -> Int -> Maybe Parameters+tr808_variant t n = fmap (!! n) (lookup t tr808_set)++-- | The set of all 'TR808' data.+tr808_u :: [(TR808,Parameters)]+tr808_u =+ let f (i,j) = zip (repeat i) j+ in concatMap f tr808_set++-- | Lookup 'Index' for 'TR808' at indicated 'Parameters'.+tr808_index :: TR808 -> Parameters -> Index tr808_index i ps = let nm = tr808_file_name i ps err = error "tr808_index"- in fromMaybe err (findIndex (== nm) tr808_file_map)+ in fromMaybe err (elemIndex nm tr808_file_map) -- | Buffer /allocate and read/ message for @scsynth@.-tr808_alloc_osc :: FilePath -> (FilePath,Int) -> OSC+tr808_alloc_osc :: FilePath -> (FilePath,Int) -> Message tr808_alloc_osc d (fn,i) = b_allocRead i (d </> fn) 0 0 -- | Complete set of 'tr808_alloc_osc' messages for 'TR808'.-tr808_alloc_all_osc :: FilePath -> [OSC]+tr808_alloc_all_osc :: FilePath -> [Message] 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 -> 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 -- | Send 'OSC' set given by 'tr808_alloc_all_osc' to @scsynth@ at -- 'Transport'.-au_load_tr808_set :: Transport t => FilePath -> t -> IO ()-au_load_tr808_set d fd = mapM_ (async fd) (tr808_alloc_all_osc d)+au_load_tr808_set :: Transport m => FilePath -> m ()+au_load_tr808_set d = mapM_ async (tr808_alloc_all_osc d) {--let d = "/home/rohan/disk/proudhon/data/tr-808"+let d = "/home/rohan/disk/proudhon/data/audio/instr/tr-808-mf" tr808_alloc_all_osc d let f = tr808_index in tr808_alloc_subset_osc d [f RS [],f CL [],f CH []] -}
hsc3-auditor.cabal view
@@ -1,15 +1,15 @@ Name: hsc3-auditor-Version: 0.11+Version: 0.12 Synopsis: Haskell SuperCollider Auditor Description: A simple-minded auditioner for music structures. License: GPL Category: Sound-Copyright: (c) Rohan Drape, 2010-2011+Copyright: (c) Rohan Drape, 2010-2012 Author: Rohan Drape Maintainer: rd@slavepianos.org Stability: Experimental-Homepage: http://slavepianos.org/rd/?t=hsc3-auditor-Tested-With: GHC == 7.2.2+Homepage: http://rd.slavepianos.org/?t=hsc3-auditor+Tested-With: GHC == 7.6.1 Build-Type: Simple Cabal-Version: >= 1.8 @@ -18,9 +18,9 @@ Library Build-Depends: base == 4.*, filepath,- hmt == 0.11.*,- hosc == 0.11.*,- hsc3 == 0.11.*+ hmt == 0.12.*,+ hosc == 0.12.*,+ hsc3 == 0.12.* GHC-Options: -Wall -fwarn-tabs Exposed-modules: Sound.SC3.Auditor Sound.SC3.Auditor.PF@@ -28,4 +28,4 @@ Source-Repository head Type: darcs- Location: http://slavepianos.org/rd/sw/hsc3-auditor+ Location: http://rd.slavepianos.org/sw/hsc3-auditor