Auditor.hs

-- | 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)