module Sound.SC3.Auditor.TR808 where
import Data.List
import Data.Maybe
import Sound.OSC
import Sound.SC3
import Sound.SC3.Auditor
import System.FilePath
data TR808 = BD
| SD
| LT'
| MT
| HT
| LC
| MC
| HC
| RS
| CL
| CP
| MA
| CB
| CY
| OH
| CH
deriving (Eq,Ord,Enum,Bounded,Show)
data Position = P0 | P1 | P2 | P3 | P4
deriving (Eq,Ord,Enum,Bounded,Show)
type Parameters = [Position]
position_text :: Position -> String
position_text i =
case i of
P0 -> "00"
P1 -> "25"
P2 -> "50"
P3 -> "75"
P4 -> "10"
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
tr808_abbrev :: TR808 -> String
tr808_abbrev i =
case i of
LT' -> "LT"
_ -> show i
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"
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"
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"
tr808_file_map :: [FilePath]
tr808_file_map = concatMap tr808_file_names [minBound .. maxBound]
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)
tr808_variant :: TR808 -> Int -> Maybe Parameters
tr808_variant t n = fmap (!! n) (lookup t tr808_set)
tr808_u :: [(TR808,Parameters)]
tr808_u =
let f (i,j) = zip (repeat i) j
in concatMap f tr808_set
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)
tr808_alloc_osc :: FilePath -> (FilePath,Int) -> Message
tr808_alloc_osc d (fn,i) = b_allocRead i (d </> fn) 0 0
tr808_alloc_all_osc :: FilePath -> [Message]
tr808_alloc_all_osc d = map (tr808_alloc_osc d) (zip tr808_file_map [0..])
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
au_load_tr808_set :: Transport m => FilePath -> m ()
au_load_tr808_set d = mapM_ async (tr808_alloc_all_osc d)