TR808.hs

-- | /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 []]
-}