packages feed

hsc3-auditor (empty) → 0.11

raw patch · 6 files changed

+376/−0 lines, 6 filesdep +basedep +filepathdep +hmtsetup-changed

Dependencies added: base, filepath, hmt, hosc, hsc3

Files

+ README view
@@ -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/
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ Sound/SC3/Auditor.hs view
@@ -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)
+ Sound/SC3/Auditor/PF.hs view
@@ -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)]))+-}
+ Sound/SC3/Auditor/TR808.hs view
@@ -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 []]+-}
+ hsc3-auditor.cabal view
@@ -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