-- | /TR808/ sample library based auditioner.
module Sound.SC3.Auditor.TR808 where

import Data.List
import Data.Maybe
import Sound.OSC {- hosc -}
import Sound.SC3 {- hsc3 -}
import Sound.SC3.Auditor
import System.FilePath {- filepath -}

-- | Enumeration of TR808 instruments.
data TR808 = BD -- ^ Bass Drum
           | SD -- ^ Snare Drum
           | LT' -- ^ Low Tom
           | MT -- ^ Mid Tom
           | HT -- ^ High Tom
           | LC -- ^ Low Conga
           | MC -- ^ Mid Conga
           | HC -- ^ High Conga
           | RS -- ^ Rim Shot
           | CL -- ^ Claves
           | CP -- ^ Hand Clap
           | MA -- ^ Maracas
           | CB -- ^ Cow Bell
           | CY -- ^ Cymbal
           | OH -- ^ Open Hi-Hat
           | CH -- ^ Closed Hi-Hat
             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 'Parameters' for a 'TR808' instrument.
tr808_set :: [(TR808,[Parameters])]
tr808_set =
    let ts = [minBound .. maxBound]
        ps = [minBound .. maxBound]
        f t = case tr808_n_param t of
                0 -> [[]]
                1 -> [[p] | p <- ps]
                2 -> [[p0,p1] | p0 <- ps, p1 <- ps]
                _ -> error "tr808_set"
    in zip ts (map f ts)

-- | Lookup 'tr808_set' for the /n/th variant of 'TR808'.
tr808_variant :: TR808 -> Int -> Maybe Parameters
tr808_variant t n = fmap (!! n) (lookup t tr808_set)

-- | The set of all 'TR808' data.
tr808_u :: [(TR808,Parameters)]
tr808_u =
    let f (i,j) = zip (repeat i) j
    in concatMap f tr808_set

-- | 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 (elemIndex nm tr808_file_map)

-- | Buffer /allocate and read/ message for @scsynth@.
tr808_alloc_osc :: FilePath -> (FilePath,Int) -> Message
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 -> [Message]
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 m => FilePath -> m ()
au_load_tr808_set d = mapM_ async (tr808_alloc_all_osc d)

{-
let d = "/home/rohan/disk/proudhon/data/audio/instr/tr-808-mf"
tr808_alloc_all_osc d
let f = tr808_index in tr808_alloc_subset_osc d [f RS [],f CL [],f CH []]
-}