FCD.hs

{-| Farfisa (electronics)

Recordings of FARFISA COMPACT DUO from B3 to D#6.

Registrations flute8, oboe8, trumpet8, strings8.

With and without vibrato.

Files are each recorded in one pass, metronome m=54, measure=6/4.

flute8, oboe8, trumpet8 were recorded together and balance is natural.

strings8 was recorded later, balance is below.

strings8 ought to balance with trumpet8.

-}
module Sound.SC3.Auditor.FCD where

import Data.List {- base -}
import Data.Maybe {- base -}
import System.FilePath {- filepath -}

import qualified Music.Theory.List as T
import qualified Music.Theory.Pitch as T

import Sound.OSC {- hosc -}
import Sound.SC3 {- hsc3 -}

import qualified Sound.File.HSndFile as F {- hsc3-sf-hsndfile -}

import qualified Sound.SC3.Auditor.Smplr as A

fcd_dir :: FilePath
fcd_dir = "/home/rohan/data/audio/instr/farfisa/aad"

-- | There are four separate registrations (three used in aad).
fcd_registrations_plain :: [String]
fcd_registrations_plain = ["flute8","oboe8","trumpet8","strings8"]

-- | Each has a vibrato variant.
fcd_registrations_vib :: [String]
fcd_registrations_vib = map (++ "-vib") fcd_registrations_plain

-- | Making eight registrations in total.
fcd_registrations :: [String]
fcd_registrations = T.interleave fcd_registrations_plain fcd_registrations_vib

-- | Having indices @0@ through @7@.
fcd_registrations_ix :: [Int]
fcd_registrations_ix = [0..7]

-- | Stored as @flac@.
fcd_format :: String
fcd_format = "flac"

-- | The files of the recordings of the eight registrations.
fcd_fnames :: [FilePath]
fcd_fnames =
    let f k = fcd_dir </> k <.> fcd_format
    in map f fcd_registrations

-- | 'header' of 'fcd_fnames.
--
-- > h <- fcd_hdr
-- > length h == 8
-- > map frameCount h
fcd_hdr :: IO [F.Header]
fcd_hdr = mapM F.header fcd_fnames

-- | The recorded duration for each tone (in seconds), ie. ts=6/4 at q=54.
--
-- > fcd_sample_dur == 6 + 2/3
fcd_sample_dur :: Fractional n => n
fcd_sample_dur = 20/3

-- | Range (inclusive) of recorded tones.
fcd_range :: (T.OctPC,T.OctPC)
fcd_range = ((3,11),(6,3))

bimap1 :: (t -> u) -> (t, t) -> (u, u)
bimap1 f (p,q) = (f p,f q)

-- | As midi note numbers.
fcd_range_midi :: Num n => (n,n)
fcd_range_midi = bimap1 (fromIntegral . T.octpc_to_midi) fcd_range

-- | All of the recorded midi note numbers.
--
-- > length fcd_gamut_midi == 29
fcd_gamut_midi :: (Enum n,Num n) => [n]
fcd_gamut_midi = let (l,r) = fcd_range_midi in [l .. r]

-- | (note-predicate,sf-header,sf-name)
type SF_LD = (Int -> Bool,F.Header,FilePath)

-- | The odd form allows selective loading based on /m/, where the
-- buffer numbers are as if all were loaded.
--
-- st = start time (sec.), du = duration (sec.), b = buffer-id, m = midi-note number
sf_load_msg :: SF_LD -> Double -> Double -> Int -> Int -> Maybe Message
sf_load_msg (sel_f,hdr,fn) st du b m =
  let nf = F.frameCount hdr
      sr = F.sampleRate hdr
      nc = F.channelCount hdr
      st' = round (st * sr)
      du' = round (du * sr)
  in if nc /= 1 || nf < st' + du'
     then error "sf_load: not mono or out of range"
     else if sel_f m
          then Just (b_allocRead b fn st' du')
          else Nothing

-- k = degree (number of allocations), du = duration of each allocation
sf_load_seq_msg :: SF_LD -> Int -> Double -> (Double,Double) -> Int -> [Message]
sf_load_seq_msg opt k du (st_d,en_d) b =
    let st = map (+ st_d) [du, du * 2 ..]
        du' = map (subtract en_d) (repeat du)
        m = zipWith4 (sf_load_msg opt) st du' [b .. b + k - 1] fcd_gamut_midi
    in catMaybes m

-- > m <- fmap (fcd_load_seq_msg fcd_sel_f 0) fcd_hdr
-- > map length m == replicate 8 (length pitch_collection_midi)
-- > withSC3 (mapM_ async (concat m))
--
-- > m' <- fmap (fcd_load_seq_msg (const True) 0) fcd_hdr
-- > withSC3 (mapM_ async (concat m'))
fcd_load_seq_msg :: (Int -> Bool) -> Int -> [F.Header] -> [[Message]]
fcd_load_seq_msg sel_f b0 h =
  let f hdr fn = sf_load_seq_msg (sel_f,hdr,fn) 29 (20/3) (0.25,0.25)
      b = [b0,b0 + 29 ..]
  in zipWith3 f h fcd_fnames b

-- > fcd_load_sel (const True) 0
fcd_load_sel :: (Int -> Bool) -> Int -> IO ()
fcd_load_sel sel_f b0 = do
  m <- fmap (fcd_load_seq_msg sel_f b0) fcd_hdr
  withSC3 (mapM_ async (concat m))

-- | Here /k/ is the set of registrations to load.
fcd_load_all_msg :: Int -> [Int] -> IO [Message]
fcd_load_all_msg b0 k = do
  h <- fcd_hdr
  let h' = map (h !!) k
      msg = fcd_load_seq_msg (const True) b0 h'
  return (concat msg)

-- > fcd_load_all 0 [0]
fcd_load_all :: Int -> [Int] -> IO ()
fcd_load_all b0 k = do
  m <- fcd_load_all_msg b0 k
  withSC3 (mapM_ async m)

-- * Smplr

-- > range_degree fcd_range_midi == 29
range_degree :: Num a => (a,a) -> a
range_degree (l,r) = r - l + 1

-- ch = channel assignment mode, nid = node id, b0 = buffer zero, m =
-- midi note number, dt = detune (cents), du = duration, g = gain, n =
-- registration, bus = output bus, grp = group to allocate node at, p2
-- = further synthesis parameters
--
-- > let opt = (fcd_range_midi,"pn",-1,0,(0.05,0.15),0,1,[]) :: A.SMPLR_OPT
-- > withSC3 (send (fcd_smplr opt 0 (60,0) (Just 2) 1))
--
-- > withSC3 (send (fcd_smplr opt 0 (30,0) Nothing 1))
-- > withSC3 (send (n_set1 (-1) "gate" 0))
fcd_smplr :: A.SMPLR_OPT -> Int -> (Int,Double) -> Maybe Double -> Double -> Message
fcd_smplr (rng,ch,nid,b0,(aT,rT),bus,grp,p2) n (m,dt) du g =
    let n' = n `mod` 6
        b0' = b0 + range_degree rng * n'
        -- level adjustments, flute8 is quiet etc.
        g' = g * case n' of
                   0 -> 4
                   1 -> 4
                   2 -> 1
                   3 -> 1
                   4 -> 0.5
                   5 -> 0.5
                   _ -> error "fcd_smplr: level adjustment"
    in A.smplr_msg (rng,ch,nid,b0',(aT,rT),bus,grp,p2) (m,dt) du g'

fcd_init :: Int -> [Int] -> IO [Bundle]
fcd_init b0 k = do
  let f = bundle 0 . return
      sy = A.smplr_recv_all_msg
  ld <- fcd_load_all_msg b0 k
  return (map f sy ++ map f ld ++ [f (g_new [(1,AddToTail,0)])])