-- | Tuning type
module Music.Theory.Tuning.Type where

import Data.List {- base -}
import Data.Maybe {- base -}

import qualified Music.Theory.Either as T {- hmt -}
import qualified Music.Theory.Math.Prime as T {- hmt -}
import qualified Music.Theory.Tuning as T {- hmt -}

-- * Tuning

-- | A tuning specified 'Either' as a sequence of exact ratios, or as
-- a sequence of possibly inexact 'Cents', and an octave if not 2:1 or 1200.
--
-- In both cases, the values are given in relation to the first degree
-- of the scale, which for ratios is 1 and for cents 0.
data Tuning = Tuning {Tuning -> Either [Rational] [Approximate_Ratio]
tn_ratios_or_cents :: Either [Rational] [T.Cents]
                     ,Tuning -> Maybe (Either Rational Approximate_Ratio)
tn_octave :: Maybe (Either Rational T.Cents)}
              deriving (Tuning -> Tuning -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tuning -> Tuning -> Bool
$c/= :: Tuning -> Tuning -> Bool
== :: Tuning -> Tuning -> Bool
$c== :: Tuning -> Tuning -> Bool
Eq,Int -> Tuning -> ShowS
[Tuning] -> ShowS
Tuning -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tuning] -> ShowS
$cshowList :: [Tuning] -> ShowS
show :: Tuning -> String
$cshow :: Tuning -> String
showsPrec :: Int -> Tuning -> ShowS
$cshowsPrec :: Int -> Tuning -> ShowS
Show)

-- | Default epsilon for recovering ratios from cents.
tn_epsilon :: Double
tn_epsilon :: Approximate_Ratio
tn_epsilon = Approximate_Ratio
0.001

-- | Tuning value as rational, reconstructed if required.
tn_as_ratio :: Double -> Either Rational T.Cents -> Rational
tn_as_ratio :: Approximate_Ratio -> Either Rational Approximate_Ratio -> Rational
tn_as_ratio Approximate_Ratio
epsilon = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (Approximate_Ratio -> Approximate_Ratio -> Rational
T.reconstructed_ratio Approximate_Ratio
epsilon)

-- | Tuning value as cents.
tn_as_cents :: Either Rational T.Cents -> T.Cents
tn_as_cents :: Either Rational Approximate_Ratio -> Approximate_Ratio
tn_as_cents = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall i. Integral i => Ratio i -> Approximate_Ratio
T.ratio_to_cents forall a. a -> a
id

-- | Tuning octave, defaulting to 2:1.
tn_octave_def :: Tuning -> Either Rational T.Cents
tn_octave_def :: Tuning -> Either Rational Approximate_Ratio
tn_octave_def = forall a. a -> Maybe a -> a
fromMaybe (forall a b. a -> Either a b
Left Rational
2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> Maybe (Either Rational Approximate_Ratio)
tn_octave

-- | Tuning octave in cents.
tn_octave_cents :: Tuning -> T.Cents
tn_octave_cents :: Tuning -> Approximate_Ratio
tn_octave_cents = Either Rational Approximate_Ratio -> Approximate_Ratio
tn_as_cents forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> Either Rational Approximate_Ratio
tn_octave_def

-- | Tuning octave as ratio cents.
tn_octave_ratio :: Double -> Tuning -> Rational
tn_octave_ratio :: Approximate_Ratio -> Tuning -> Rational
tn_octave_ratio Approximate_Ratio
epsilon = Approximate_Ratio -> Either Rational Approximate_Ratio -> Rational
tn_as_ratio Approximate_Ratio
epsilon forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> Either Rational Approximate_Ratio
tn_octave_def

-- | Divisions of octave.
--
-- > tn_divisions (tn_equal_temperament 12) == 12
tn_divisions :: Tuning -> Int
tn_divisions :: Tuning -> Int
tn_divisions = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> Either [Rational] [Approximate_Ratio]
tn_ratios_or_cents

-- | 'Maybe' exact ratios of 'Tuning', NOT including the octave.
tn_ratios :: Tuning -> Maybe [Rational]
tn_ratios :: Tuning -> Maybe [Rational]
tn_ratios = forall a b. Either a b -> Maybe a
T.from_left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> Either [Rational] [Approximate_Ratio]
tn_ratios_or_cents

-- | Limit of JI tuning.
tn_limit :: Tuning -> Maybe Integer
tn_limit :: Tuning -> Maybe Integer
tn_limit = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall i. Integral i => Ratio i -> i
T.rational_prime_limit) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> Maybe [Rational]
tn_ratios

-- | 'error'ing variant.
tn_ratios_err :: Tuning -> [Rational]
tn_ratios_err :: Tuning -> [Rational]
tn_ratios_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"ratios") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> Maybe [Rational]
tn_ratios

-- | Possibly inexact 'Cents' of tuning, NOT including the octave.
tn_cents :: Tuning -> [T.Cents]
tn_cents :: Tuning -> [Approximate_Ratio]
tn_cents = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. (a -> b) -> [a] -> [b]
map forall i. Integral i => Ratio i -> Approximate_Ratio
T.ratio_to_cents) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> Either [Rational] [Approximate_Ratio]
tn_ratios_or_cents

-- | 'map' 'round' '.' 'cents'.
tn_cents_i :: Integral i => Tuning -> [i]
tn_cents_i :: forall i. Integral i => Tuning -> [i]
tn_cents_i = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> [Approximate_Ratio]
tn_cents

-- | Variant of 'tn_cents' that includes octave at right.
tn_cents_octave :: Tuning -> [T.Cents]
tn_cents_octave :: Tuning -> [Approximate_Ratio]
tn_cents_octave Tuning
t = Tuning -> [Approximate_Ratio]
tn_cents Tuning
t forall a. [a] -> [a] -> [a]
++ [Tuning -> Approximate_Ratio
tn_octave_cents Tuning
t]

-- | 'tn_cents' / 100
tn_fmidi :: Tuning -> [Double]
tn_fmidi :: Tuning -> [Approximate_Ratio]
tn_fmidi = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
* Approximate_Ratio
0.01) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuning -> [Approximate_Ratio]
tn_cents

-- | Possibly inexact 'Approximate_Ratio's of tuning.
tn_approximate_ratios :: Tuning -> [T.Approximate_Ratio]
tn_approximate_ratios :: Tuning -> [Approximate_Ratio]
tn_approximate_ratios =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. (a -> b) -> [a] -> [b]
map Rational -> Approximate_Ratio
T.approximate_ratio) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Floating a => a -> a
T.cents_to_fratio) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Tuning -> Either [Rational] [Approximate_Ratio]
tn_ratios_or_cents

-- | Cyclic form, taking into consideration 'octave_ratio'.
tn_approximate_ratios_cyclic :: Tuning -> [T.Approximate_Ratio]
tn_approximate_ratios_cyclic :: Tuning -> [Approximate_Ratio]
tn_approximate_ratios_cyclic Tuning
t =
    let r :: [Approximate_Ratio]
r = Tuning -> [Approximate_Ratio]
tn_approximate_ratios Tuning
t
        m :: Approximate_Ratio
m = forall a. Floating a => a -> a
T.cents_to_fratio (Tuning -> Approximate_Ratio
tn_octave_cents Tuning
t)
        g :: [Approximate_Ratio]
g = forall a. (a -> a) -> a -> [a]
iterate (forall a. Num a => a -> a -> a
* Approximate_Ratio
m) Approximate_Ratio
1
        f :: Approximate_Ratio -> [Approximate_Ratio]
f Approximate_Ratio
n = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
* Approximate_Ratio
n) [Approximate_Ratio]
r
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Approximate_Ratio -> [Approximate_Ratio]
f [Approximate_Ratio]
g

-- | Lookup function that allows both negative & multiple octave indices.
--
-- > :l Music.Theory.Tuning.DB.Werckmeister
-- > let map_zip f l = zip l (map f l)
-- > map_zip (tn_ratios_lookup werckmeister_vi) [-24 .. 24]
tn_ratios_lookup :: Tuning -> Int -> Maybe Rational
tn_ratios_lookup :: Tuning -> Int -> Maybe Rational
tn_ratios_lookup Tuning
t Int
n =
    let (Int
o,Int
pc) = Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` Tuning -> Int
tn_divisions Tuning
t
        o_ratio :: Rational
o_ratio = forall a. Integral a => Ratio a -> Int -> Ratio a
T.oct_diff_to_ratio (Approximate_Ratio -> Tuning -> Rational
tn_octave_ratio Approximate_Ratio
tn_epsilon Tuning
t) Int
o
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Rational]
r -> Rational
o_ratio forall a. Num a => a -> a -> a
* ([Rational]
r forall a. [a] -> Int -> a
!! Int
pc)) (Tuning -> Maybe [Rational]
tn_ratios Tuning
t)

-- | Lookup function that allows both negative & multiple octave indices.
--
-- > map_zip (tn_approximate_ratios_lookup werckmeister_v) [-24 .. 24]
tn_approximate_ratios_lookup :: Tuning -> Int -> T.Approximate_Ratio
tn_approximate_ratios_lookup :: Tuning -> Int -> Approximate_Ratio
tn_approximate_ratios_lookup Tuning
t Int
n =
    let (Int
o,Int
pc) = Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` Tuning -> Int
tn_divisions Tuning
t
        o_ratio :: Approximate_Ratio
o_ratio = forall a. Fractional a => Rational -> a
fromRational (forall a. Integral a => Ratio a -> Int -> Ratio a
T.oct_diff_to_ratio (Approximate_Ratio -> Tuning -> Rational
tn_octave_ratio Approximate_Ratio
tn_epsilon Tuning
t) Int
o)
    in Approximate_Ratio
o_ratio forall a. Num a => a -> a -> a
* (Tuning -> [Approximate_Ratio]
tn_approximate_ratios Tuning
t forall a. [a] -> Int -> a
!! Int
pc)

-- | 'Maybe' exact ratios reconstructed from possibly inexact 'Cents'
-- of 'Tuning'.
--
-- > :l Music.Theory.Tuning.DB.Werckmeister
-- > let r = [1,17/16,9/8,13/11,5/4,4/3,7/5,3/2,11/7,5/3,16/9,15/8]
-- > tn_reconstructed_ratios 1e-2 werckmeister_iii == Just r
tn_reconstructed_ratios :: Double -> Tuning -> Maybe [Rational]
tn_reconstructed_ratios :: Approximate_Ratio -> Tuning -> Maybe [Rational]
tn_reconstructed_ratios Approximate_Ratio
epsilon =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (Approximate_Ratio -> Approximate_Ratio -> Rational
T.reconstructed_ratio Approximate_Ratio
epsilon)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall x t. Either x t -> Maybe t
T.from_right forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Tuning -> Either [Rational] [Approximate_Ratio]
tn_ratios_or_cents

-- * Equal temperaments

-- | Make /n/ division equal temperament.
tn_equal_temperament :: Integral n => n -> Tuning
tn_equal_temperament :: forall n. Integral n => n -> Tuning
tn_equal_temperament n
n =
    let c :: [Approximate_Ratio]
c = forall i a. Integral i => i -> [a] -> [a]
genericTake n
n [Approximate_Ratio
0,Approximate_Ratio
1200 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n ..]
    in Either [Rational] [Approximate_Ratio]
-> Maybe (Either Rational Approximate_Ratio) -> Tuning
Tuning (forall a b. b -> Either a b
Right [Approximate_Ratio]
c) forall a. Maybe a
Nothing

-- | 12-tone equal temperament.
--
-- > tn_cents tn_equal_temperament_12 == [0,100..1100]
tn_equal_temperament_12 :: Tuning
tn_equal_temperament_12 :: Tuning
tn_equal_temperament_12 = forall n. Integral n => n -> Tuning
tn_equal_temperament (Int
12::Int)

-- | 19-tone equal temperament.
--
-- > let c = [0,63,126,189,253,316,379,442,505,568,632,695,758,821,884,947,1011,1074,1137]
-- > tn_cents_i tn_equal_temperament_19 == c
tn_equal_temperament_19 :: Tuning
tn_equal_temperament_19 :: Tuning
tn_equal_temperament_19 = forall n. Integral n => n -> Tuning
tn_equal_temperament (Int
19::Int)

-- | 31-tone equal temperament.
tn_equal_temperament_31 :: Tuning
tn_equal_temperament_31 :: Tuning
tn_equal_temperament_31 = forall n. Integral n => n -> Tuning
tn_equal_temperament (Int
31::Int)

-- | 53-tone equal temperament.
tn_equal_temperament_53 :: Tuning
tn_equal_temperament_53 :: Tuning
tn_equal_temperament_53 = forall n. Integral n => n -> Tuning
tn_equal_temperament (Int
53::Int)

-- | 72-tone equal temperament.
--
-- > let r = [0,17,33,50,67,83,100]
-- > take 7 (map round (tn_cents tn_equal_temperament_72)) == r
tn_equal_temperament_72 :: Tuning
tn_equal_temperament_72 :: Tuning
tn_equal_temperament_72 = forall n. Integral n => n -> Tuning
tn_equal_temperament (Int
72::Int)

-- | 96-tone equal temperament.
tn_equal_temperament_96 :: Tuning
tn_equal_temperament_96 :: Tuning
tn_equal_temperament_96 = forall n. Integral n => n -> Tuning
tn_equal_temperament (Int
96::Int)