-- | Command line interface to hmt/scala.
module Music.Theory.Tuning.Scala.Cli where

import Data.Char {- base -}
import Data.List {- base -}
import System.Environment {- base -}
import Text.Printf {- base -}

import qualified Music.Theory.Array.Text as T {- hmt-base -}
import qualified Music.Theory.Function as T {- hmt-base -}
import qualified Music.Theory.List as T {- hmt-base -}
import qualified Music.Theory.Read as T {- hmt-base -}
import qualified Music.Theory.Show as T {- hmt-base -}

import qualified Music.Theory.Array.Csv.Midi.Mnd as T {- hmt -}
import qualified Music.Theory.Pitch as T {- hmt -}
import qualified Music.Theory.Pitch.Spelling.Table as T {- hmt -}
import qualified Music.Theory.Time.Seq as T {- hmt -}
import qualified Music.Theory.Tuning as T {- hmt -}
import qualified Music.Theory.Tuning.Et as T {- hmt -}
import qualified Music.Theory.Tuning.Midi as T {- hmt -}
import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
import qualified Music.Theory.Tuning.Scala.Kbm as Kbm {- hmt -}
import qualified Music.Theory.Tuning.Scala.Functions as Functions {- hmt -}
import qualified Music.Theory.Tuning.Scala.Interval as Interval {- hmt -}
import qualified Music.Theory.Tuning.Scala.Mode as Mode {- hmt -}
import qualified Music.Theory.Tuning.Type as T {- hmt -}

type R = Double

db_stat :: IO ()
db_stat :: IO ()
db_stat = do
  [Scale]
db <- IO [Scale]
Scala.scl_load_db
  let po :: [Maybe (Either Double Rational)]
po = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right Rational
2)) (forall a b. (a -> b) -> [a] -> [b]
map Scale -> Maybe (Either Double Rational)
Scala.scale_octave [Scale]
db)
      uf :: [Scale]
uf = forall a. (a -> Bool) -> [a] -> [a]
filter Scale -> Bool
Scala.is_scale_uniform [Scale]
db
      r :: [String]
r = [String
"# entries        : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Scale]
db)
          ,String
"# perfect-octave : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe (Either Double Rational)]
po)
          ,String
"# scale-uniform  : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Scale]
uf)]
  String -> IO ()
putStrLn ([String] -> String
unlines [String]
r)

-- > db_summarise (Just 15) (Just 65)
db_summarise :: Maybe Int -> Maybe Int -> IO ()
db_summarise :: Maybe Int -> Maybe Int -> IO ()
db_summarise Maybe Int
nm_lim Maybe Int
dsc_lim = do
  [Scale]
db <- IO [Scale]
Scala.scl_load_db
  let nm_seq :: [String]
nm_seq = forall a b. (a -> b) -> [a] -> [b]
map Scale -> String
Scala.scale_name [Scale]
db
      nm_max :: Int
nm_max = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
nm_seq)) forall a. a -> a
id Maybe Int
nm_lim
      dsc_seq :: [String]
dsc_seq = forall a b. (a -> b) -> [a] -> [b]
map Scale -> String
Scala.scale_description [Scale]
db
      fmt :: ([a], [a]) -> t
fmt ([a]
nm,[a]
dsc) = forall r. PrintfType r => String -> r
printf String
"%-*s : %s" Int
nm_max (forall a. Int -> [a] -> [a]
take Int
nm_max [a]
nm) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
dsc (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> [a] -> [a]
take [a]
dsc) Maybe Int
dsc_lim)
      tbl :: [String]
tbl = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {t}.
(IsChar a, IsChar a, PrintfType t) =>
([a], [a]) -> t
fmt (forall a b. [a] -> [b] -> [(a, b)]
zip [String]
nm_seq [String]
dsc_seq)
  String -> IO ()
putStrLn ([String] -> String
unlines [String]
tbl)

env :: IO ()
env :: IO ()
env = do
  [String]
scl_dir <- IO [String]
Scala.scl_get_dir
  String
dist_dir <- String -> IO String
getEnv String
"SCALA_DIST_DIR"
  String -> IO ()
putStrLn (String
"SCALA_SCL_DIR = " forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
scl_dir then String
"NOT SET" else forall a. [a] -> [[a]] -> [a]
intercalate String
":" [String]
scl_dir)
  String -> IO ()
putStrLn (String
"SCALA_DIST_DIR = " forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dist_dir then String
"NOT SET" else String
dist_dir)

cut :: Maybe Int -> [a] -> [a]
cut :: forall a. Maybe Int -> [a] -> [a]
cut Maybe Int
lm [a]
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a]
s (\Int
n -> forall a. Int -> [a] -> [a]
take Int
n [a]
s) Maybe Int
lm

search :: (IO [a], a -> String, a -> [String]) -> (Bool, Maybe Int) -> [String] -> IO ()
search :: forall a.
(IO [a], a -> String, a -> [String])
-> (Bool, Maybe Int) -> [String] -> IO ()
search (IO [a]
load_f,a -> String
descr_f,a -> [String]
stat_f) (Bool
ci,Maybe Int
lm) [String]
txt = do
  [a]
db <- IO [a]
load_f
  let modify :: String -> String
modify = if Bool
ci then forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower else forall a. a -> a
id
      txt' :: [String]
txt' = forall a b. (a -> b) -> [a] -> [b]
map String -> String
modify [String]
txt
      db' :: [a]
db' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall t. [t -> Bool] -> t -> Bool
T.predicate_all (forall a b. (a -> b) -> [a] -> [b]
map forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [String]
txt') forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
descr_f) [a]
db
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe Int -> [a] -> [a]
cut Maybe Int
lm) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [String]
stat_f) [a]
db'

-- > search_scale (True,Nothing) ["xenakis"]
-- > search_scale (True,Just 75) ["lamonte","young"]
search_scale :: (Bool,Maybe Int) -> [String] -> IO ()
search_scale :: (Bool, Maybe Int) -> [String] -> IO ()
search_scale = forall a.
(IO [a], a -> String, a -> [String])
-> (Bool, Maybe Int) -> [String] -> IO ()
search (IO [Scale]
Scala.scl_load_db,Scale -> String
Scala.scale_description,Scale -> [String]
Scala.scale_stat)

-- > search_mode (True,Nothing) ["xenakis"]
search_mode :: (Bool,Maybe Int) -> [String] -> IO ()
search_mode :: (Bool, Maybe Int) -> [String] -> IO ()
search_mode = forall a.
(IO [a], a -> String, a -> [String])
-> (Bool, Maybe Int) -> [String] -> IO ()
search (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ModeNam -> [Mode]
Mode.modenam_modes IO ModeNam
Mode.load_modenam,Mode -> String
Mode.mode_description,Mode -> [String]
Mode.mode_stat)

-- > stat_all Nothing
stat_all :: Maybe Int -> IO ()
stat_all :: Maybe Int -> IO ()
stat_all Maybe Int
character_limit = do
  [Scale]
db <- IO [Scale]
Scala.scl_load_db
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe Int -> [a] -> [a]
cut Maybe Int
character_limit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale -> [String]
Scala.scale_stat) [Scale]
db

-- > stat_by_name Nothing "young-lm_piano"
stat_by_name :: Maybe Int -> FilePath -> IO ()
stat_by_name :: Maybe Int -> String -> IO ()
stat_by_name Maybe Int
lm String
nm = do
  Scale
sc <- String -> IO Scale
Scala.scl_load String
nm
  String -> IO ()
putStrLn ([String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe Int -> [a] -> [a]
cut Maybe Int
lm) (Scale -> [String]
Scala.scale_stat Scale
sc)))

-- > rng_enum (60,72) == [60 .. 72]
rng_enum :: Enum t => (t,t) -> [t]
rng_enum :: forall t. Enum t => (t, t) -> [t]
rng_enum (t
l,t
r) = [t
l .. t
r]

cps_tbl :: String -> T.Mnn_Cps_Table -> (T.Midi,T.Midi) -> IO ()
cps_tbl :: String -> Mnn_Cps_Table -> (Int, Int) -> IO ()
cps_tbl String
fmt Mnn_Cps_Table
tbl (Int, Int)
mnn_rng = do
  let cps_pp :: Double -> String
cps_pp = Int -> Double -> String
T.double_pp Int
2
      cents_pp :: Double -> String
cents_pp = Int -> Double -> String
T.double_pp Int
1
      gen_t :: Int -> (Int, Pitch, Double)
gen_t Int
i = (Int
i,forall i. Integral i => i -> Pitch
T.midi_to_pitch_ks Int
i,forall k v. Eq k => k -> [(k, v)] -> v
T.lookup_err Int
i Mnn_Cps_Table
tbl)
      t_pp :: (a, Pitch, Double) -> [String]
t_pp (a
i,Pitch
p,Double
cps) =
          let ref :: Double
ref = forall i f. (Integral i, Floating f) => i -> f
T.midi_to_cps a
i
              (Double
_,Pitch
nr,Double
nr_cps,Double
_,Double
_) = (Double, Double)
-> Double -> (Double, Pitch, Double, Double, Double)
T.nearest_12et_tone_k0 (Double
69,Double
440) Double
cps
          in [forall a. Show a => a -> String
show a
i
             ,Double -> String
cps_pp Double
cps,Pitch -> String
T.pitch_pp_iso Pitch
nr,Double -> String
cents_pp (forall r n. (Real r, Fractional r, Floating n) => r -> r -> n
T.cps_difference_cents Double
nr_cps Double
cps)
             ,Double -> String
cps_pp Double
ref,Pitch -> String
T.pitch_pp_iso Pitch
p,Double -> String
cents_pp (forall r n. (Real r, Fractional r, Floating n) => r -> r -> n
T.cps_difference_cents Double
ref Double
cps)]
      hdr :: [String]
hdr = [String
"MNN"
            ,String
"CPS",String
"ET12",String
"CENTS-/+"
            ,String
"REF CPS",String
"REF ET12",String
"CENTS-/+"]
      dat :: [[String]]
dat = forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. (Show a, Integral a) => (a, Pitch, Double) -> [String]
t_pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int, Pitch, Double)
gen_t) (forall t. Enum t => (t, t) -> [t]
rng_enum (Int, Int)
mnn_rng)
      ln :: [String]
ln = case String
fmt of
             String
"md" -> Text_Table_Opt -> [[String]] -> [String]
T.table_pp Text_Table_Opt
T.table_opt_simple ([String]
hdr forall a. a -> [a] -> [a]
: [[String]]
dat)
             String
"csv" -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate String
",") [[String]]
dat
             String
_ -> forall a. HasCallStack => String -> a
error String
"cps_tbl: fmt?"
  String -> IO ()
putStr ([String] -> String
unlines [String]
ln)

-- > cps_tbl_d12 "md" ("young-lm_piano",-74.7,-3) (60,72)
cps_tbl_d12 :: String -> (String,T.Cents,T.Midi) -> (T.Midi,T.Midi) -> IO ()
cps_tbl_d12 :: String -> (String, Double, Int) -> (Int, Int) -> IO ()
cps_tbl_d12 String
fmt (String
nm,Double
c,Int
k) (Int, Int)
mnn_rng = do
  Tuning
t <- String -> IO Tuning
Scala.scl_load_tuning String
nm :: IO T.Tuning
  let tbl :: Mnn_Cps_Table
tbl = Sparse_Midi_Tuning_f -> Mnn_Cps_Table
T.gen_cps_tuning_tbl (Midi_Tuning_f -> Sparse_Midi_Tuning_f
T.lift_tuning_f (D12_Midi_Tuning -> Midi_Tuning_f
T.d12_midi_tuning_f (Tuning
t,Double
c,Int
k)))
  String -> Mnn_Cps_Table -> (Int, Int) -> IO ()
cps_tbl String
fmt Mnn_Cps_Table
tbl (Int, Int)
mnn_rng

-- > cps_tbl_cps "md" ("cet111",27.5,9,127-9) (69,69+25)
cps_tbl_cps :: String -> (String,R,T.Midi,Int) -> (T.Midi,T.Midi) -> IO ()
cps_tbl_cps :: String -> (String, Double, Int, Int) -> (Int, Int) -> IO ()
cps_tbl_cps String
fmt (String
nm,Double
f0,Int
k,Int
n) (Int, Int)
mnn_rng = do
  Tuning
t <- String -> IO Tuning
Scala.scl_load_tuning String
nm
  let tbl :: Mnn_Cps_Table
tbl = Sparse_Midi_Tuning_f -> Mnn_Cps_Table
T.gen_cps_tuning_tbl (Cps_Midi_Tuning -> Sparse_Midi_Tuning_f
T.cps_midi_tuning_f (Tuning
t,Double
f0,Int
k,Int
n))
  String -> Mnn_Cps_Table -> (Int, Int) -> IO ()
cps_tbl String
fmt Mnn_Cps_Table
tbl (Int, Int)
mnn_rng

csv_mnd_retune_d12 :: (String,T.Cents,T.Midi) -> FilePath -> FilePath -> IO ()
csv_mnd_retune_d12 :: (String, Double, Int) -> String -> String -> IO ()
csv_mnd_retune_d12 (String
nm,Double
c,Int
k) String
in_fn String
out_fn = do
  Tuning
t <- String -> IO Tuning
Scala.scl_load_tuning String
nm
  let retune_f :: Int -> Double
retune_f = forall m c. (Integral m, Real c) => (m, c) -> Double
T.midi_detune_to_fmidi forall b c a. (b -> c) -> (a -> b) -> a -> c
. D12_Midi_Tuning -> Midi_Tuning_f
T.d12_midi_tuning_f (Tuning
t,Double
c,Int
k)
  Wseq Double (Double, Double, Int, Param)
m <- forall t n.
(Read t, Real t, Read n, Real n) =>
String -> IO (Wseq t (Event n))
T.csv_midi_read_wseq String
in_fn :: IO (T.Wseq R (R,R,T.Channel,T.Param))
  let f :: (a, (a, b, c, d)) -> (a, (Double, b, c, d))
f (a
tm,(a
mnn,b
vel,c
ch,d
pm)) = (a
tm,(Int -> Double
retune_f (forall a b. (RealFrac a, Integral b) => a -> b
floor a
mnn),b
vel,c
ch,d
pm))
  forall t n.
(Real t, Real n) =>
Int -> String -> Wseq t (Event n) -> IO ()
T.csv_mndd_write_wseq Int
4 String
out_fn (forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {b} {c} {d}.
RealFrac a =>
(a, (a, b, c, d)) -> (a, (Double, b, c, d))
f Wseq Double (Double, Double, Int, Param)
m)

-- > fluidsynth_tuning_d12 ("young-lm_piano",0,0) ("young-lm_piano",-74.7,-3)
fluidsynth_tuning_d12 :: (String,Int,Int) -> (String,T.Cents,T.Midi) -> IO ()
fluidsynth_tuning_d12 :: (String, Int, Int) -> (String, Double, Int) -> IO ()
fluidsynth_tuning_d12 (String
fs_name,Int
fs_bank,Int
fs_prog) (String
nm,Double
c,Int
k) = do
  Tuning
t <- String -> IO Tuning
Scala.scl_load_tuning String
nm :: IO T.Tuning
  let tun_f :: Midi_Tuning_f
tun_f = D12_Midi_Tuning -> Midi_Tuning_f
T.d12_midi_tuning_f (Tuning
t,Double
c,Int
k)
      pp_f :: Int -> t
pp_f Int
n = let (Int
mnn,Double
dt) = Midi_Tuning_f
tun_f Int
n
                   cents :: Double
cents = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mnn forall a. Num a => a -> a -> a
* Double
100 forall a. Num a => a -> a -> a
+ Double
dt
                   cents_non_neg :: Double
cents_non_neg = if Double
cents forall a. Ord a => a -> a -> Bool
< Double
0 then Double
0 else Double
cents
               in forall r. PrintfType r => String -> r
printf String
"tune %d %d %d %.2f" Int
fs_bank Int
fs_prog Int
n Double
cents_non_neg
      l :: [String]
l = forall r. PrintfType r => String -> r
printf String
"tuning \"%s\" %d %d" String
fs_name Int
fs_bank Int
fs_prog forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {t}. PrintfType t => Int -> t
pp_f [Int
0 .. Int
127]
  String -> IO ()
putStrLn ([String] -> String
unlines [String]
l)

{-
import Data.Int {- base -}
import Data.Word {- base -}

int_to_int8 :: Int -> Int8
int_to_int8 = fromIntegral

int8_to_word8 :: Int8 -> Word8
int8_to_word8 = fromIntegral

midi_tbl_binary_mnn_cents_tuning_d12 :: FilePath -> (String,T.Cents,Int) -> IO ()
midi_tbl_binary_mnn_cents_tuning_d12 fn (nm,c,k) = do
  t <- Scala.scl_load_tuning nm :: IO T.Tuning
  let tun_f = T.d12_midi_tuning_f (t,c,k)
      pp_f n = let (mnn,dt) = T.midi_detune_normalise (tun_f n)
               in [int_to_int8 mnn,int_to_int8 (round dt)]
  B.writeFile fn (B.pack (map int8_to_word8 (concatMap pp_f [0 .. 127])))
-}

{-
> midi_tbl_tuning_d12 "freq" ("meanquar",0,0)
> midi_tbl_tuning_d12 "fmidi" ("meanquar",0,0)
> midi_tbl_tuning_d12 "mts" ("young-lm_piano",-74.7,-3)
-}
midi_tbl_tuning_d12 :: String -> (String,T.Cents,T.Midi) -> IO ()
midi_tbl_tuning_d12 :: String -> (String, Double, Int) -> IO ()
midi_tbl_tuning_d12 String
typ (String
nm,Double
c,Int
k) = do
  Tuning
t <- String -> IO Tuning
Scala.scl_load_tuning String
nm :: IO T.Tuning
  let tun_f :: Midi_Tuning_f
tun_f = D12_Midi_Tuning -> Midi_Tuning_f
T.d12_midi_tuning_f (Tuning
t,Double
c,Int
k)
      pp_f :: Int -> t
pp_f Int
n =
        case String
typ of
          String
"fmidi" -> forall r. PrintfType r => String -> r
printf String
"%3d,%10.6f" Int
n (forall m c. (Integral m, Real c) => (m, c) -> Double
T.midi_detune_to_fmidi (Midi_Tuning_f
tun_f Int
n))
          String
"freq" -> forall r. PrintfType r => String -> r
printf String
"%3d,%10.4f" Int
n (forall m c. (Integral m, Real c) => (m, c) -> Double
T.midi_detune_to_cps (Midi_Tuning_f
tun_f Int
n))
          String
"mts" ->
            let (Int
mnn,Double
dt) = forall m c. (Num m, Ord m, Ord c, Num c) => (m, c) -> (m, c)
T.midi_detune_normalise_positive (Midi_Tuning_f
tun_f Int
n)
            in forall r. PrintfType r => String -> r
printf String
"%3d,%3d,%7.4f" Int
n (Int
mnn forall a. Integral a => a -> a -> a
`mod` Int
0x80) Double
dt
          String
_ -> forall a. HasCallStack => String -> a
error String
"midi_tbl_tuning_d12"
  String -> IO ()
putStr ([String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall {t}. PrintfType t => Int -> t
pp_f [Int
0 .. Int
127]))

ratio_cents_pp :: Rational -> String
ratio_cents_pp :: Rational -> String
ratio_cents_pp = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (RealFrac a, Integral b) => a -> b
round :: Double -> Int) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Ratio i -> Double
T.ratio_to_cents

-- > intnam_lookup [7/4,7/6,9/8,13/8]
intnam_lookup :: [Rational] -> IO ()
intnam_lookup :: [Rational] -> IO ()
intnam_lookup [Rational]
r_sq = do
  let f :: INTNAM -> Rational -> String
f INTNAM
db Rational
r = let nm :: String
nm = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"*Unknown*" forall a b. (a, b) -> b
snd (INTNAM -> Rational -> Maybe INTERVAL
Interval.intnam_search_ratio INTNAM
db Rational
r)
               in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Rational -> String
T.ratio_pp Rational
r,String
" = ",String
nm,String
" = ",Rational -> String
ratio_cents_pp Rational
r]
  INTNAM
db <- IO INTNAM
Interval.load_intnam
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. INTNAM -> Rational -> String
f INTNAM
db) [Rational]
r_sq

-- > intnam_search "didymus"
intnam_search :: String -> IO ()
intnam_search :: String -> IO ()
intnam_search String
txt = do
  INTNAM
db <- IO INTNAM
Interval.load_intnam
  let f :: INTERVAL -> String
f (Rational
r,String
nm) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Rational -> String
T.ratio_pp Rational
r,String
" = ",String
nm,String
" = ",Rational -> String
ratio_cents_pp Rational
r]
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. INTERVAL -> String
f) (INTNAM -> String -> [INTERVAL]
Interval.intnam_search_description_ci INTNAM
db String
txt)

kbm_tbl :: String -> String -> String -> IO ()
kbm_tbl :: String -> String -> String -> IO ()
kbm_tbl String
ty String
scl_nm String
kbm_nm = do
  Scale
scl <- String -> IO Scale
Scala.scl_load String
scl_nm
  Kbm
kbm <- String -> IO Kbm
Kbm.kbm_load String
kbm_nm
  let tbl :: Mnn_Cps_Table
tbl = case String
ty of
        String
"cps" -> Kbm -> Scale -> Mnn_Cps_Table
Kbm.kbm_cps_tbl Kbm
kbm Scale
scl
        String
"fmidi" -> Kbm -> Scale -> Mnn_Cps_Table
Kbm.kbm_fmidi_tbl Kbm
kbm Scale
scl
        String
_ -> forall a. HasCallStack => String -> a
error String
"kbm_tbl: unknown type"
      fmt :: (t, t) -> t
fmt (t
i,t
j) = forall r. PrintfType r => String -> r
printf String
"%d,%.4f" t
i t
j
      txt :: String
txt = [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall {t} {t} {t}.
(PrintfArg t, PrintfArg t, PrintfType t) =>
(t, t) -> t
fmt Mnn_Cps_Table
tbl)
  String -> IO ()
putStrLn String
txt

-- * Main

help :: [String]
help :: [String]
help =
    [String
"cps-tbl md|csv cps name:string f0:real mnn0:int gamut:int mnn-l:int mnn-r:int"
    ,String
"cps-tbl md|csv d12 name:string cents:real mnn:int mnn-l:int mnn-r:int"
    ,String
"csv-mnd-retune d12 name:string cents:real mnn:int input-file output-file"
    ,String
"db stat"
    ,String
"db summarise nm-lm|nil dsc-lm|nil"
    ,String
"env"
    ,String
"fluidsynth d12 scl-name:string cents:real mnn:int fs-name:string fs-bank:int fs-prog:int"
    ,String
"intervals {half-matrix|list|matrix} {cents|ratios} scale-name:string"
    ,String
"intname lookup interval:rational..."
    ,String
"intname search text:string"
    ,String
"kbm table {cps | fmidi} scala-name:string kbm-name:string"
    ,String
"midi-table fmidi|freq|mts d12 name:string cents:real mnn:int"
    ,String
"search scale|mode ci|cs lm|nil text:string..."
    ,String
"stat all lm|nil"
    ,String
"stat scale lm|nil name:string|file-path"
    ,String
""
    ,String
"  lm:int = line character limit"]

nil_or_read :: Read a => String -> Maybe a
nil_or_read :: forall a. Read a => String -> Maybe a
nil_or_read String
s = if String
s forall a. Eq a => a -> a -> Bool
== String
"nil" then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. Read a => String -> a
T.read_err String
s)

scala_cli :: [String] -> IO ()
scala_cli :: [String] -> IO ()
scala_cli [String]
arg = do
  let usage :: IO ()
usage = String -> IO ()
putStrLn ([String] -> String
unlines [String]
help)
  case [String]
arg of
    [String
"cps-tbl",String
fmt,String
"cps",String
nm,String
f0,String
k,String
n,String
l,String
r] -> String -> (String, Double, Int, Int) -> (Int, Int) -> IO ()
cps_tbl_cps String
fmt (String
nm,forall a. Read a => String -> a
read String
f0,forall a. Read a => String -> a
read String
k,forall a. Read a => String -> a
read String
n) (forall a. Read a => String -> a
read String
l,forall a. Read a => String -> a
read String
r)
    [String
"cps-tbl",String
fmt,String
"d12",String
nm,String
c,String
k,String
l,String
r] -> String -> (String, Double, Int) -> (Int, Int) -> IO ()
cps_tbl_d12 String
fmt (String
nm,forall a. Read a => String -> a
read String
c,forall a. Read a => String -> a
read String
k) (forall a. Read a => String -> a
read String
l,forall a. Read a => String -> a
read String
r)
    [String
"csv-mnd-retune",String
"d12",String
nm,String
c,String
k,String
in_fn,String
out_fn] -> (String, Double, Int) -> String -> String -> IO ()
csv_mnd_retune_d12 (String
nm,forall a. Read a => String -> a
read String
c,forall a. Read a => String -> a
read String
k) String
in_fn String
out_fn
    [String
"db",String
"stat"] -> IO ()
db_stat
    [String
"db",String
"summarise",String
nm_lim,String
dsc_lim] -> Maybe Int -> Maybe Int -> IO ()
db_summarise (forall a. Read a => String -> Maybe a
nil_or_read String
nm_lim) (forall a. Read a => String -> Maybe a
nil_or_read String
dsc_lim)
    [String
"env"] -> IO ()
env
    [String
"fluidsynth",String
"d12",String
scl_nm,String
c,String
k,String
fs_nm,String
fs_bank,String
fs_prog] ->
        (String, Int, Int) -> (String, Double, Int) -> IO ()
fluidsynth_tuning_d12 (String
fs_nm,forall a. Read a => String -> a
read String
fs_bank,forall a. Read a => String -> a
read String
fs_prog) (String
scl_nm,forall a. Read a => String -> a
read String
c,forall a. Read a => String -> a
read String
k)
    [String
"intervals",String
"half-matrix",Char
'c':String
_,String
k,String
nm] -> Int -> String -> IO ()
Functions.intervals_half_matrix_cents (forall a. Read a => String -> a
read String
k) String
nm
    [String
"intervals",String
"half-matrix",Char
'r':String
_,String
nm] -> String -> IO ()
Functions.intervals_half_matrix_ratios String
nm
    [String
"intervals",String
"list",Char
'r':String
_,String
nm] -> String -> IO ()
Functions.intervals_list_ratios String
nm
    [String
"intervals",String
"matrix",Char
'c':String
_,String
k,String
nm] -> Int -> String -> IO ()
Functions.intervals_matrix_cents (forall a. Read a => String -> a
read String
k) String
nm
    [String
"intervals",String
"matrix",Char
'r':String
_,String
nm] -> String -> IO ()
Functions.intervals_matrix_ratios String
nm
    String
"intnam":String
"lookup":[String]
r_sq -> [Rational] -> IO ()
intnam_lookup (forall a b. (a -> b) -> [a] -> [b]
map forall i. (Integral i, Read i) => String -> Ratio i
T.read_ratio_with_div_err [String]
r_sq)
    [String
"intnam",String
"search",String
txt] -> String -> IO ()
intnam_search String
txt
    [String
"kbm",String
"table",String
ty,String
scl_nm,String
kbm_nm] -> String -> String -> String -> IO ()
kbm_tbl String
ty String
scl_nm String
kbm_nm
    [String
"midi-table",String
typ,String
"d12",String
scl_nm,String
c,String
k] -> String -> (String, Double, Int) -> IO ()
midi_tbl_tuning_d12 String
typ (String
scl_nm,forall a. Read a => String -> a
read String
c,forall a. Read a => String -> a
read String
k)
    String
"search":String
ty:String
ci:String
lm:[String]
txt ->
        case String
ty of
          String
"scale" -> (Bool, Maybe Int) -> [String] -> IO ()
search_scale (String
ci forall a. Eq a => a -> a -> Bool
== String
"ci",forall a. Read a => String -> Maybe a
nil_or_read String
lm) [String]
txt
          String
"mode" -> (Bool, Maybe Int) -> [String] -> IO ()
search_mode (String
ci forall a. Eq a => a -> a -> Bool
== String
"ci",forall a. Read a => String -> Maybe a
nil_or_read String
lm) [String]
txt
          String
_ -> IO ()
usage
    [String
"stat",String
"all",String
lm] -> Maybe Int -> IO ()
stat_all (forall a. Read a => String -> Maybe a
nil_or_read String
lm)
    [String
"stat",String
"scale",String
lm,String
nm] -> Maybe Int -> String -> IO ()
stat_by_name (forall a. Read a => String -> Maybe a
nil_or_read String
lm) String
nm
    [String]
_ -> IO ()
usage