-- | Functions to load a tuning definition and transform it into a sparse tuning function.
module Music.Theory.Tuning.Load where

import System.Random {- random -}

import qualified Music.Theory.Array.Csv as T {- hmt-base -}

import qualified Music.Theory.Pitch as T {- hmt -}
import qualified Music.Theory.Tuning as T
import qualified Music.Theory.Tuning.Midi as T
import qualified Music.Theory.Tuning.Scala as T
import qualified Music.Theory.Tuning.Type as T

-- | Load possibly sparse and possibly one-to-many
-- (midi-note-number,cps-frequency) table from Csv file.
--
-- > load_cps_tbl "/home/rohan/dr.csv"
load_cps_tbl :: FilePath -> IO [(T.Midi,Double)]
load_cps_tbl :: FilePath -> IO [(Midi, Double)]
load_cps_tbl FilePath
nm = do
  Table FilePath
tbl <- forall a. (FilePath -> a) -> FilePath -> IO (Table a)
T.csv_table_read_def forall a. a -> a
id FilePath
nm
  let f :: [FilePath] -> (a, b)
f [FilePath]
e = case [FilePath]
e of
              [FilePath
p,FilePath
q] -> (forall a. Read a => FilePath -> a
read FilePath
p,forall a. Read a => FilePath -> a
read FilePath
q)
              [FilePath]
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"load_cps_tbl"
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. (Read a, Read b) => [FilePath] -> (a, b)
f Table FilePath
tbl)

-- | Load scala scl file as 'T.Tuning'.
load_tuning_scl :: String -> IO T.Tuning
load_tuning_scl :: FilePath -> IO Tuning
load_tuning_scl = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scale -> Tuning
T.scale_to_tuning forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Scale
T.scl_load

-- | cps = (tuning-name,frequency-zero,midi-note-number-of-f0)
--   d12 = (tuning-name,cents-deviation,midi-note-offset)
type Load_Tuning_Opt = (String,Double,T.Midi)

-- | Load scala file and apply 'T.cps_midi_tuning_f'.
load_tuning_cps :: Load_Tuning_Opt -> IO T.Sparse_Midi_Tuning_f
load_tuning_cps :: Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_cps (FilePath
nm,Double
f0,Midi
k) =
    let f :: Tuning -> Sparse_Midi_Tuning_f
f Tuning
tn = Cps_Midi_Tuning -> Sparse_Midi_Tuning_f
T.cps_midi_tuning_f (Tuning
tn,Double
f0,Midi
k,Midi
128 forall a. Num a => a -> a -> a
- Midi -> Midi
T.midi_to_int Midi
k)
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tuning -> Sparse_Midi_Tuning_f
f (FilePath -> IO Tuning
load_tuning_scl FilePath
nm)

-- | Load scala file and apply 'T.d12_midi_tuning_f'.
load_tuning_d12 :: Load_Tuning_Opt -> IO T.Sparse_Midi_Tuning_f
load_tuning_d12 :: Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_d12 (FilePath
nm,Double
dt,Midi
k) =
    let f :: Tuning -> Sparse_Midi_Tuning_f
f Tuning
tn = Midi_Tuning_f -> Sparse_Midi_Tuning_f
T.lift_tuning_f (D12_Midi_Tuning -> Midi_Tuning_f
T.d12_midi_tuning_f (Tuning
tn,Double
dt,Midi
k))
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tuning -> Sparse_Midi_Tuning_f
f (FilePath -> IO Tuning
load_tuning_scl FilePath
nm)

-- | Lookup first matching element in table.
load_tuning_tbl :: Load_Tuning_Opt -> IO T.Sparse_Midi_Tuning_f
load_tuning_tbl :: Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_tbl (FilePath
nm,Double
dt,Midi
k) =
    let from_cps :: Double -> (Midi, Double)
from_cps = Double -> (Midi, Double)
T.cps_to_midi_detune forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Floating a => a -> a -> a
T.cps_shift_cents Double
dt
        f :: [(Midi, Double)] -> Sparse_Midi_Tuning_f
f [(Midi, Double)]
tbl Midi
mnn = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> (Midi, Double)
from_cps (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Midi
mnn forall a. Num a => a -> a -> a
+ Midi
k) [(Midi, Double)]
tbl)
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Midi, Double)] -> Sparse_Midi_Tuning_f
f (FilePath -> IO [(Midi, Double)]
load_cps_tbl FilePath
nm)

type Choose_f st t = [t] -> st-> (t,st)

-- | Randomly choose from elements in table, equal weighting.
default_choose_f :: RandomGen g => Choose_f g t
default_choose_f :: forall g t. RandomGen g => Choose_f g t
default_choose_f [t]
l g
g =
    let (Midi
i,g
g') = forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Midi
0,forall (t :: * -> *) a. Foldable t => t a -> Midi
length [t]
l forall a. Num a => a -> a -> a
- Midi
1) g
g
    in ([t]
l forall a. [a] -> Midi -> a
!! Midi
i,g
g')

-- | Load tuning table with stateful selection function for one-to-many entries.
load_tuning_tbl_st :: Choose_f st (T.Midi,Double) -> Load_Tuning_Opt -> IO (T.Sparse_Midi_Tuning_St_f st)
load_tuning_tbl_st :: forall st.
Choose_f st (Midi, Double)
-> Load_Tuning_Opt -> IO (Sparse_Midi_Tuning_St_f st)
load_tuning_tbl_st Choose_f st (Midi, Double)
choose_f (FilePath
nm,Double
dt,Midi
k) =
    let from_cps :: Double -> (Midi, Double)
from_cps = Double -> (Midi, Double)
T.cps_to_midi_detune forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Floating a => a -> a -> a
T.cps_shift_cents Double
dt
        f :: [(Midi, Double)] -> st -> Midi -> (st, Maybe (Midi, Double))
f [(Midi, Double)]
tbl st
g Midi
mnn = case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== (Midi
mnn forall a. Num a => a -> a -> a
+ Midi
k)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Midi, Double)]
tbl of
                        [] -> (st
g,forall a. Maybe a
Nothing)
                        [(Midi, Double)]
l -> let ((Midi
_,Double
e),st
g') = Choose_f st (Midi, Double)
choose_f [(Midi, Double)]
l st
g
                             in (st
g',forall a. a -> Maybe a
Just (Double -> (Midi, Double)
from_cps Double
e))
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Midi, Double)] -> st -> Midi -> (st, Maybe (Midi, Double))
f (FilePath -> IO [(Midi, Double)]
load_cps_tbl FilePath
nm)

load_tuning_ty :: String -> Load_Tuning_Opt -> IO T.Sparse_Midi_Tuning_f
load_tuning_ty :: FilePath -> Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_ty FilePath
ty Load_Tuning_Opt
opt =
    case FilePath
ty of
      FilePath
"cps" -> Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_cps Load_Tuning_Opt
opt
      FilePath
"d12" -> Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_d12 Load_Tuning_Opt
opt
      FilePath
"tbl" -> Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_tbl Load_Tuning_Opt
opt
      FilePath
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"cps|d12|tbl"

load_tuning_st_ty :: String -> Load_Tuning_Opt -> IO (T.Sparse_Midi_Tuning_St_f StdGen)
load_tuning_st_ty :: FilePath -> Load_Tuning_Opt -> IO (Sparse_Midi_Tuning_St_f StdGen)
load_tuning_st_ty FilePath
ty Load_Tuning_Opt
opt =
    case FilePath
ty of
      FilePath
"cps" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall st. Sparse_Midi_Tuning_f -> Sparse_Midi_Tuning_St_f st
T.lift_sparse_tuning_f (Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_cps Load_Tuning_Opt
opt)
      FilePath
"d12" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall st. Sparse_Midi_Tuning_f -> Sparse_Midi_Tuning_St_f st
T.lift_sparse_tuning_f (Load_Tuning_Opt -> IO Sparse_Midi_Tuning_f
load_tuning_d12 Load_Tuning_Opt
opt)
      FilePath
"tbl" -> forall st.
Choose_f st (Midi, Double)
-> Load_Tuning_Opt -> IO (Sparse_Midi_Tuning_St_f st)
load_tuning_tbl_st forall g t. RandomGen g => Choose_f g t
default_choose_f Load_Tuning_Opt
opt
      FilePath
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"cps|d12|tbl"