diff --git a/README b/README --- a/README +++ b/README @@ -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/ diff --git a/Sound/SC3/Auditor.hs b/Sound/SC3/Auditor.hs --- a/Sound/SC3/Auditor.hs +++ b/Sound/SC3/Auditor.hs @@ -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) 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,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)])) -} 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 @@ -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 []] -} 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.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