Auditor.hs

-- | Auditor functions common to all sample libraries.
module Sound.SC3.Auditor where

import Data.List {- base -}
import Sound.OSC {- hosc -}
import Sound.SC3 {- hsc3 -}

-- | Amplitude
type Amplitude = Double

-- | Index
type Index = Int

-- | Number of channels
type NC = Int

type Note = (Index,Amplitude)

-- | Chord
type Chord = [Note]

-- | Duration
type Duration = Double

-- | Start time
type Start_Time = Double

-- | 'Start_Time' and 'Chord'.
type P = (Start_Time,Chord)

-- | 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] -> [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 -> Duration
pp_duration = p_start_time . last

-- | The set of 'Index' referenced to by 'PP'.
pp_indices :: PP -> [Index]
pp_indices = nub . sort . concatMap (chord_indices . p_chord)

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 :: P -> Bundle
p_osc (t,c) = bundle t (chd_osc c)

-- | 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 0 [group_zero,instr_osc nc]
                  in h : map (b 0 . return) (ld ix)
        sc_end = [b (pp_duration pp + 12) [g_freeAll [1]]]
  in NRT (sc_init ++ map p_osc pp ++ sc_end)

-- | Variant of 'pp_osc' that writes @NRT@ score to named file using
-- 'writeNRT'.
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 -> Message
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 m => NC -> m ()
au_load_instr nc = do
  _ <- async (instr_osc nc)
  return ()

au_chd :: Transport m => (Chord,Duration) -> m ()
au_chd (c,d) = do
  --putStrLn ("au_chd: " ++ show d)
  mapM_ send (chd_osc c)
  pauseThread d

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 m) => PP -> m ()
pp_audition pp = mapM_ au_chd (pp_st_to_dur pp)