-- | Scala functions, <http://www.huygens-fokker.org/scala/help.htm>
module Music.Theory.Tuning.Scala.Functions where

import Data.List {- base -}

import qualified Music.Theory.Array.Text as Text {- hmt -}
import qualified Music.Theory.List as List {- hmt -}
import qualified Music.Theory.Math as Math {- hmt -}
import qualified Music.Theory.Show as Show {- hmt -}
import qualified Music.Theory.Tuning as Tuning {- hmt -}
import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
import qualified Music.Theory.Tuning.Scala.Interval as Interval {- hmt -}

{- | <http://www.huygens-fokker.org/scala/help.htm#EQUALTEMP>

> map round (equaltemp 12 2 13) == [0,100,200,300,400,500,600,700,800,900,1000,1100,1200]
> map round (equaltemp 13 3 14) == [0,146,293,439,585,732,878,1024,1170,1317,1463,1609,1756,1902]
> map round (equaltemp 12.5 3 14) == [0,152,304,456,609,761,913,1065,1217,1369,1522,1674,1826,1978]
-}
equaltemp :: Double -> Double -> Int -> [Double]
equaltemp :: Cents -> Cents -> Int -> [Cents]
equaltemp Cents
division Cents
octave Int
scale_size =
  let step :: Cents
step = forall r n. (Real r, Floating n) => r -> n
Tuning.fratio_to_cents Cents
octave forall a. Fractional a => a -> a -> a
/ Cents
division
  in forall a. Int -> [a] -> [a]
take Int
scale_size [Cents
0,Cents
step ..]

{- | <http://www.huygens-fokker.org/scala/help.htm#LINEARTEMP>

> let py = lineartemp 12 2 () (3/2 :: Rational) 3
> py == [1/1,2187/2048,9/8,32/27,81/64,4/3,729/512,3/2,6561/4096,27/16,16/9,243/128,2/1]
-}
lineartemp :: (Fractional n, Ord n) => Int -> n -> () -> n -> Int -> [n]
lineartemp :: forall n.
(Fractional n, Ord n) =>
Int -> n -> () -> n -> Int -> [n]
lineartemp Int
scale_size n
octave ()
_degree_of_fifth n
fifth Int
down =
  let geom :: t -> t -> [t]
geom t
i t
m = t
i forall a. a -> [a] -> [a]
: t -> t -> [t]
geom (t
i forall a. Num a => a -> a -> a
* t
m) t
m
      geom_oct :: b -> b -> [b]
geom_oct b
i = forall a b. (a -> b) -> [a] -> [b]
map forall n. (Ord n, Fractional n) => n -> n
Tuning.fold_ratio_to_octave_err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t}. Num t => t -> t -> [t]
geom b
i
      lhs :: [n]
lhs = forall a. Int -> [a] -> [a]
take (Int
down forall a. Num a => a -> a -> a
+ Int
1) (forall {b}. (Ord b, Fractional b) => b -> b -> [b]
geom_oct n
1 (n
1 forall a. Fractional a => a -> a -> a
/ n
fifth))
      rhs :: [n]
rhs = forall a. [a] -> [a]
tail (forall a. Int -> [a] -> [a]
take (Int
scale_size forall a. Num a => a -> a -> a
- Int
down) (forall {b}. (Ord b, Fractional b) => b -> b -> [b]
geom_oct n
1 n
fifth))
  in forall a. Ord a => [a] -> [a]
sort ([n]
lhs forall a. [a] -> [a] -> [a]
++ [n]
rhs) forall a. [a] -> [a] -> [a]
++ [n
octave]

-- * INTERVALS

interval_hist_ratios :: (Fractional t,Ord t) => [t] -> [(t,Int)]
interval_hist_ratios :: forall t. (Fractional t, Ord t) => [t] -> [(t, Int)]
interval_hist_ratios [t]
x = forall a. Ord a => [a] -> [(a, Int)]
List.histogram [(if t
p forall a. Ord a => a -> a -> Bool
< t
q then t
p forall a. Num a => a -> a -> a
* t
2 else t
p) forall a. Fractional a => a -> a -> a
/ t
q | t
p <- [t]
x, t
q <- [t]
x, t
p forall a. Eq a => a -> a -> Bool
/= t
q]

intervals_list_ratios_r :: Interval.INTNAM -> [Rational] -> IO ()
intervals_list_ratios_r :: INTNAM -> [Rational] -> IO ()
intervals_list_ratios_r INTNAM
nam_db [Rational]
rat = do
  let hst :: [(Rational, Int)]
hst = forall t. (Fractional t, Ord t) => [t] -> [(t, Int)]
interval_hist_ratios [Rational]
rat
      ln :: (Rational, a) -> [String]
ln (Rational
r,a
n) = let nm :: String
nm = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" forall a b. (a, b) -> b
snd (INTNAM -> Rational -> Maybe INTERVAL
Interval.intnam_search_ratio INTNAM
nam_db Rational
r)
                     c :: Cents
c = forall i. Integral i => Ratio i -> Cents
Tuning.ratio_to_cents Rational
r
                     i :: Int
i = forall r. Real r => r -> Int
Math.real_round_int (Cents
c forall a. Fractional a => a -> a -> a
/ Cents
100)
                 in [forall a. Show a => a -> String
show Int
i,forall a. Show a => a -> String
show a
n,Rational -> String
Show.ratio_pp Rational
r,forall t. Real t => Int -> t -> String
Show.real_pp Int
1 Cents
c,String
nm]
      tbl :: [[String]]
tbl = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (Rational, a) -> [String]
ln [(Rational, Int)]
hst
      pp :: [[String]] -> [String]
pp = Text_Table_Opt -> [[String]] -> [String]
Text.table_pp Text_Table_Opt
Text.table_opt_plain
  String -> IO ()
putStrLn ([String] -> String
unlines ([[String]] -> [String]
pp [[String]]
tbl))

{- | <http://www.huygens-fokker.org/scala/help.htm#SHOW_INTERVALS>

> mapM_ intervals_list_ratios (words "pyth_12 kepler1")
-}
intervals_list_ratios :: String -> IO ()
intervals_list_ratios :: String -> IO ()
intervals_list_ratios String
scl_nm = do
  INTNAM
nam_db <- IO INTNAM
Interval.load_intnam
  Scale
scl <- String -> IO Scale
Scala.scl_load String
scl_nm
  INTNAM -> [Rational] -> IO ()
intervals_list_ratios_r INTNAM
nam_db (forall a. [a] -> [a]
tail (Scale -> [Rational]
Scala.scale_ratios_req Scale
scl))

-- * INTERVALS

-- | Given interval function (ie. '-' or '/') and scale generate interval half-matrix.
interval_half_matrix :: (t -> t -> u) -> [t] -> [[u]]
interval_half_matrix :: forall t u. (t -> t -> u) -> [t] -> [[u]]
interval_half_matrix t -> t -> u
interval_f =
  let tails' :: [a] -> [[a]]
tails' = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>= Int
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails
      f :: [t] -> [u]
f [t]
l = case [t]
l of
              [] -> []
              t
i : [t]
l' -> forall a b. (a -> b) -> [a] -> [b]
map (t -> t -> u
`interval_f` t
i) [t]
l'
  in forall a b. (a -> b) -> [a] -> [b]
map [t] -> [u]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails'

interval_half_matrix_tbl :: (t -> String) -> (t -> t -> t) -> [t] -> [[String]]
interval_half_matrix_tbl :: forall t. (t -> String) -> (t -> t -> t) -> [t] -> [[String]]
interval_half_matrix_tbl t -> String
show_f t -> t -> t
interval_f [t]
scl =
    let f :: Int -> [t] -> [String]
f Int
n [t]
l = forall a. Int -> a -> [a]
replicate Int
n String
"" forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map t -> String
show_f [t]
l
    in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [t] -> [String]
f [Int
1..] (forall t u. (t -> t -> u) -> [t] -> [[u]]
interval_half_matrix t -> t -> t
interval_f [t]
scl)

intervals_half_matrix :: (Scala.Scale -> [t]) -> (t -> t -> t) -> (t -> String) -> String -> IO ()
intervals_half_matrix :: forall t.
(Scale -> [t]) -> (t -> t -> t) -> (t -> String) -> String -> IO ()
intervals_half_matrix Scale -> [t]
scl_f t -> t -> t
interval_f t -> String
show_f String
nm = do
  Scale
scl <- String -> IO Scale
Scala.scl_load String
nm
  let txt :: [[String]]
txt = forall t. (t -> String) -> (t -> t -> t) -> [t] -> [[String]]
interval_half_matrix_tbl t -> String
show_f t -> t -> t
interval_f (Scale -> [t]
scl_f Scale
scl)
      pp :: [[String]] -> [String]
pp = Text_Table_Opt -> [[String]] -> [String]
Text.table_pp Text_Table_Opt
Text.table_opt_plain
  String -> IO ()
putStrLn ([String] -> String
unlines ([[String]] -> [String]
pp [[String]]
txt))

-- > mapM_ (intervals_half_matrix_cents 0) (words "pyth_12 kepler1")
intervals_half_matrix_cents :: Int -> String -> IO ()
intervals_half_matrix_cents :: Int -> String -> IO ()
intervals_half_matrix_cents Int
k = forall t.
(Scale -> [t]) -> (t -> t -> t) -> (t -> String) -> String -> IO ()
intervals_half_matrix Scale -> [Cents]
Scala.scale_cents (-) (forall t. Real t => Int -> t -> String
Show.real_pp Int
k)

-- > mapM_ (intervals_half_matrix_ratios) (words "pyth_12 kepler1")
intervals_half_matrix_ratios :: String -> IO ()
intervals_half_matrix_ratios :: String -> IO ()
intervals_half_matrix_ratios = forall t.
(Scale -> [t]) -> (t -> t -> t) -> (t -> String) -> String -> IO ()
intervals_half_matrix Scale -> [Rational]
Scala.scale_ratios_req forall a. Fractional a => a -> a -> a
(/) Rational -> String
Show.ratio_pp

{-
> r = [3*5,3*7,3*11,5*7,5*11,7*11]
> r = let u = [1,3,5,7,9,11] in [i*j*k | i <- u, j <- u, k <- u, i < j, j < k]
> intervals_matrix_wr Show.ratio_pp (interval_matrix_ratio r)
-}
interval_matrix_ratio :: [Rational] -> [[Rational]]
interval_matrix_ratio :: [Rational] -> [[Rational]]
interval_matrix_ratio [Rational]
x = let f :: Rational -> [Rational]
f Rational
i = forall a b. (a -> b) -> [a] -> [b]
map (\Rational
j -> if Rational
j forall a. Ord a => a -> a -> Bool
< Rational
i then Rational
j forall a. Num a => a -> a -> a
* Rational
2 forall a. Fractional a => a -> a -> a
/ Rational
i else Rational
j forall a. Fractional a => a -> a -> a
/ Rational
i) [Rational]
x in forall a b. (a -> b) -> [a] -> [b]
map Rational -> [Rational]
f [Rational]
x

interval_matrix_cents :: [Tuning.Cents] -> [[Tuning.Cents]]
interval_matrix_cents :: [Cents] -> [[Cents]]
interval_matrix_cents [Cents]
x = let f :: Cents -> [Cents]
f Cents
i = forall a b. (a -> b) -> [a] -> [b]
map (\Cents
j -> if Cents
j forall a. Ord a => a -> a -> Bool
< Cents
i then Cents
j forall a. Num a => a -> a -> a
+ Cents
1200 forall a. Num a => a -> a -> a
- Cents
i else Cents
j forall a. Num a => a -> a -> a
- Cents
i) [Cents]
x in forall a b. (a -> b) -> [a] -> [b]
map Cents -> [Cents]
f [Cents]
x

intervals_matrix_wr :: (t -> String) -> [[t]] -> IO ()
intervals_matrix_wr :: forall t. (t -> String) -> [[t]] -> IO ()
intervals_matrix_wr t -> String
pp_f [[t]]
x = do
  let txt :: [[String]]
txt = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map t -> String
pp_f) [[t]]
x
      pp :: [[String]] -> [String]
pp = Text_Table_Opt -> [[String]] -> [String]
Text.table_pp Text_Table_Opt
Text.table_opt_plain
  String -> IO ()
putStrLn ([String] -> String
unlines ([[String]] -> [String]
pp [[String]]
txt))

intervals_matrix :: (Scala.Scale -> [t]) -> ([t] -> [[t]]) -> (t -> String) -> String -> IO ()
intervals_matrix :: forall t.
(Scale -> [t])
-> ([t] -> [[t]]) -> (t -> String) -> String -> IO ()
intervals_matrix Scale -> [t]
scl_f [t] -> [[t]]
tbl_f t -> String
pp_f String
nm = do
  Scale
scl <- String -> IO Scale
Scala.scl_load String
nm
  forall t. (t -> String) -> [[t]] -> IO ()
intervals_matrix_wr t -> String
pp_f ([t] -> [[t]]
tbl_f (Scale -> [t]
scl_f Scale
scl))

-- > mapM_ (intervals_matrix_cents 0) (words "pyth_12 kepler1")
intervals_matrix_cents :: Int -> String -> IO ()
intervals_matrix_cents :: Int -> String -> IO ()
intervals_matrix_cents Int
k = forall t.
(Scale -> [t])
-> ([t] -> [[t]]) -> (t -> String) -> String -> IO ()
intervals_matrix Scale -> [Cents]
Scala.scale_cents [Cents] -> [[Cents]]
interval_matrix_cents (forall t. Real t => Int -> t -> String
Show.real_pp Int
k)

-- > mapM_ intervals_matrix_ratios (words "pyth_12 kepler1")
intervals_matrix_ratios :: String -> IO ()
intervals_matrix_ratios :: String -> IO ()
intervals_matrix_ratios = forall t.
(Scale -> [t])
-> ([t] -> [[t]]) -> (t -> String) -> String -> IO ()
intervals_matrix Scale -> [Rational]
Scala.scale_ratios_req [Rational] -> [[Rational]]
interval_matrix_ratio Rational -> String
Show.ratio_pp