diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,10 @@ +hsc3-auditor - haskell supercollider auditioner + +A simple-minded auditioner for music structures. + + http://slavepianos.org/rd/?t=hsc3-auditor + http://haskell.org/ + http://audiosynth.com/ + +(c) rohan drape, 2010-2011 + gpl, http://gnu.org/copyleft/ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/Sound/SC3/Auditor.hs b/Sound/SC3/Auditor.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Auditor.hs @@ -0,0 +1,125 @@ +-- | 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 + +import Data.List +import qualified Music.Theory.Pitch as T {- hmt -} +import Sound.OpenSoundControl {- hosc -} +import Sound.SC3 {- hsc3 -} + +-- | Real number +type R = Double + +-- | (Octave,Pitch-class) pair +type OCTPC = (T.Octave,T.PitchClass) + +-- | Amplitude +type AMP = R + +-- | Index +type INDEX = Int + +-- | Number of channels +type NC = Int + +-- | Chord +type CHD a = [(a,AMP)] + +-- | Duration +type DUR = R + +-- | Start time +type ST = R + +-- | (Start-time,Chord) pair +type P a = (ST,CHD a) + +-- | Derivation function from 'CHD' element to 'INDEX'. +type DER a = a -> INDEX + +-- | Set of 'P' and associated 'DER' function. +type PP a = (DER a,[P a]) + +-- | Function to generate the set of 'OSC' commands required to load +-- the set of 'INDEX'ed files. +type SAMPLE_LOADER = [INDEX] -> [OSC] + +-- | Start time of last 'P' at 'PP'. +pp_duration :: PP a -> DUR +pp_duration = fst . last . snd + +-- | 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) + +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 + +p_osc :: DER a -> P a -> OSC +p_osc f (t,c) = bundle (NTPr t) (chd_osc f c) + +-- | Generate set of 'OSC' given 'NC', 'SAMPLE_LOADER' and 'PP'. +pp_osc :: NC -> SAMPLE_LOADER -> PP a -> [OSC] +pp_osc 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 + +-- | 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 + +-- * Instrument + +instr_osc :: NC -> OSC +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 + +-- | 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) + 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) + pauseThread d + +d_dx :: [(ST,a)] -> [(a,DUR)] +d_dx xs = + let (t,x) = unzip xs + 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) diff --git a/Sound/SC3/Auditor/PF.hs b/Sound/SC3/Auditor/PF.hs new file mode 100644 --- /dev/null +++ b/Sound/SC3/Auditor/PF.hs @@ -0,0 +1,58 @@ +-- | /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 + +import Sound.OpenSoundControl {- 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 +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) + +note_names :: [String] +note_names = ["C", "C#", "D", "D#", "E", "F" + ,"F#", "G", "G#", "A", "A#", "B"] + +file_names :: [String] +file_names = [(n ++ show o) <.> "aif" | o <- [1::Int .. 7], n <- note_names] + +bosendorfer_osc :: FilePath -> (String, Int) -> OSC +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 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 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) + +{- +let d = "/home/rohan/disk/proudhon/data/bosendorfer/008/" +bosendorfer_set_osc d +withSC3 (au_load_bosendorfer_set d) +withSC3 au_load_instr +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 new file mode 100644 --- /dev/null +++ b/Sound/SC3/Auditor/TR808.hs @@ -0,0 +1,149 @@ +-- | /TR808/ sample library based auditioner. +module Sound.SC3.Auditor.TR808 where + +import Data.List +import Data.Maybe +import Sound.OpenSoundControl {- 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 + deriving (Eq,Ord,Enum,Bounded,Show) + +-- | Controller positions to index sample library. +data POSITION = P0 | P1 | P2 | P3 | P4 + deriving (Eq,Ord,Enum,Bounded,Show) + +-- | Set of relevant 'POSITION' data. +type PARAMETERS = [POSITION] + +-- | Translate 'POSITION' to 'String' encoding in file names. +position_text :: POSITION -> String +position_text i = + case i of + P0 -> "00" + P1 -> "25" + P2 -> "50" + P3 -> "75" + P4 -> "10" + +-- | Function to give number of parameters for each 'TR808' instrument. +tr808_n_param :: TR808 -> Int +tr808_n_param i = + case i of + BD -> 2 + CB -> 0 + CH -> 0 + CL -> 0 + CP -> 0 + CY -> 2 + HC -> 1 + HT -> 1 + LC -> 1 + LT' -> 1 + MA -> 0 + MC -> 1 + MT -> 1 + OH -> 1 + RS -> 0 + SD -> 2 + +-- | Prettty printer variant of 'Show' instance for 'TR808'. +tr808_abbrev :: TR808 -> String +tr808_abbrev i = + case i of + LT' -> "LT" + _ -> show i + +-- | 'TR808' instrument names. +tr808_name :: TR808 -> String +tr808_name i = + case i of + BD -> "BASS DRUM" + CB -> "COW BELL" + CH -> "CLOSED HI HAT" + CL -> "CLAVES" + CP -> "HAND CLAP" + CY -> "CYMBAL" + HC -> "HIGH CONGA" + HT -> "HIGH TOM" + LC -> "LOW CONGA" + LT' -> "LOW TOM" + MA -> "MARACAS" + MC -> "MID CONGA" + MT -> "MID TOM" + OH -> "OPEN HI HAT" + RS -> "RIM SHOT" + SD -> "SNARE DRUM" + +-- | 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'. +tr808_file_names :: TR808 -> [FilePath] +tr808_file_names i = + let pp = [minBound .. maxBound] + f = map (tr808_file_name i) + in case tr808_n_param i of + 0 -> [tr808_file_name i []] + 1 -> f [[j] | j <- pp] + 2 -> f [[j,k] | j <- pp, k <- pp] + _ -> error "tr808_file_names" + +-- | The complete set of 'TR808' sample 'FilePath's. +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 = + 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 + +-- | 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) + +-- | Buffer /allocate and read/ message for @scsynth@. +tr808_alloc_osc :: FilePath -> (FilePath,Int) -> OSC +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 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 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) + +{- +let d = "/home/rohan/disk/proudhon/data/tr-808" +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 new file mode 100644 --- /dev/null +++ b/hsc3-auditor.cabal @@ -0,0 +1,31 @@ +Name: hsc3-auditor +Version: 0.11 +Synopsis: Haskell SuperCollider Auditor +Description: A simple-minded auditioner for music structures. +License: GPL +Category: Sound +Copyright: (c) Rohan Drape, 2010-2011 +Author: Rohan Drape +Maintainer: rd@slavepianos.org +Stability: Experimental +Homepage: http://slavepianos.org/rd/?t=hsc3-auditor +Tested-With: GHC == 7.2.2 +Build-Type: Simple +Cabal-Version: >= 1.8 + +Data-files: README + +Library + Build-Depends: base == 4.*, + filepath, + hmt == 0.11.*, + hosc == 0.11.*, + hsc3 == 0.11.* + GHC-Options: -Wall -fwarn-tabs + Exposed-modules: Sound.SC3.Auditor + Sound.SC3.Auditor.PF + Sound.SC3.Auditor.TR808 + +Source-Repository head + Type: darcs + Location: http://slavepianos.org/rd/sw/hsc3-auditor