module Music.Theory.Tuning.Et where
import Data.List
import Data.List.Split
import Data.Ratio
import Text.Printf
import qualified Music.Theory.List as T
import Music.Theory.Pitch
import Music.Theory.Pitch.Note
import Music.Theory.Pitch.Spelling.Table
import Music.Theory.Tuning
octpc_to_pitch_cps_k0 :: (Floating n) => (n,n) -> OctPc -> (Pitch,n)
octpc_to_pitch_cps_k0 :: forall n. Floating n => (n, n) -> OctPc -> (Pitch, n)
octpc_to_pitch_cps_k0 (n, n)
zero OctPc
x = (forall i. Integral i => Spelling i -> Octave_PitchClass i -> Pitch
octpc_to_pitch forall i. Integral i => Spelling i
pc_spell_ks OctPc
x,forall i n.
(Integral i, Floating n) =>
(n, n) -> Octave_PitchClass i -> n
octpc_to_cps_k0 (n, n)
zero OctPc
x)
octpc_to_pitch_cps :: (Floating n) => OctPc -> (Pitch,n)
octpc_to_pitch_cps :: forall n. Floating n => OctPc -> (Pitch, n)
octpc_to_pitch_cps = forall n. Floating n => (n, n) -> OctPc -> (Pitch, n)
octpc_to_pitch_cps_k0 (n
69,n
440)
tbl_12et_k0 :: (Double,Double) -> [(Pitch,Double)]
tbl_12et_k0 :: (Cents, Cents) -> [(Pitch, Cents)]
tbl_12et_k0 (Cents, Cents)
zero =
let z :: [OctPc]
z = [(Midi
o,Midi
pc) | Midi
o <- [-Midi
5 .. Midi
10], Midi
pc <- [Midi
0 .. Midi
11]]
in forall a b. (a -> b) -> [a] -> [b]
map (forall n. Floating n => (n, n) -> OctPc -> (Pitch, n)
octpc_to_pitch_cps_k0 (Cents, Cents)
zero) [OctPc]
z
tbl_12et :: [(Pitch,Double)]
tbl_12et :: [(Pitch, Cents)]
tbl_12et = (Cents, Cents) -> [(Pitch, Cents)]
tbl_12et_k0 (Cents
69,Cents
440)
tbl_24et_k0 :: (Double,Double) -> [(Pitch,Double)]
tbl_24et_k0 :: (Cents, Cents) -> [(Pitch, Cents)]
tbl_24et_k0 (Cents, Cents)
zero =
let f :: Cents -> (Pitch, Cents)
f Cents
x = let p :: Pitch
p = forall n. (Show n, RealFrac n) => Spelling Midi -> n -> Pitch
fmidi_to_pitch_err forall i. Integral i => Spelling i
pc_spell_ks Cents
x
p' :: Pitch
p' = Pitch -> Pitch
pitch_rewrite_threequarter_alteration Pitch
p
in (Pitch
p',forall a. Floating a => (a, a) -> a -> a
fmidi_to_cps_k0 (Cents, Cents)
zero Cents
x)
k0 :: Cents
k0 = -Cents
36
in forall a b. (a -> b) -> [a] -> [b]
map Cents -> (Pitch, Cents)
f [Cents
k0,Cents
k0 forall a. Num a => a -> a -> a
+ Cents
0.5 .. Cents
143.5]
tbl_24et :: [(Pitch,Double)]
tbl_24et :: [(Pitch, Cents)]
tbl_24et = (Cents, Cents) -> [(Pitch, Cents)]
tbl_24et_k0 (Cents
69,Cents
440)
bounds_et_table :: Ord s => [(t,s)] -> s -> Maybe ((t,s),(t,s))
bounds_et_table :: forall s t. Ord s => [(t, s)] -> s -> Maybe ((t, s), (t, s))
bounds_et_table = forall t s.
Bool -> (t -> s -> Ordering) -> [t] -> s -> Maybe (t, t)
T.find_bounds Bool
True (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
bounds_12et_tone :: Double -> Maybe ((Pitch,Double),(Pitch,Double))
bounds_12et_tone :: Cents -> Maybe ((Pitch, Cents), (Pitch, Cents))
bounds_12et_tone = forall s t. Ord s => [(t, s)] -> s -> Maybe ((t, s), (t, s))
bounds_et_table [(Pitch, Cents)]
tbl_12et
type HS_R p = (Double,p,Double,Double,Cents)
ndp :: Int -> Double -> String
ndp :: Midi -> Cents -> String
ndp = forall r. PrintfType r => String -> r
printf String
"%.*f"
hs_r_pp :: (p -> String) -> Int -> HS_R p -> [String]
hs_r_pp :: forall p. (p -> String) -> Midi -> HS_R p -> [String]
hs_r_pp p -> String
pp Midi
n (Cents
f,p
p,Cents
pf,Cents
_,Cents
c) = let dp :: Cents -> String
dp = Midi -> Cents -> String
ndp Midi
n in [Cents -> String
dp Cents
f,p -> String
pp p
p,Cents -> String
dp Cents
pf,Cents -> String
dp Cents
c]
hs_r_pitch_pp :: Int -> HS_R Pitch -> [String]
hs_r_pitch_pp :: Midi -> HS_R Pitch -> [String]
hs_r_pitch_pp = forall p. (p -> String) -> Midi -> HS_R p -> [String]
hs_r_pp Pitch -> String
pitch_pp
nearest_et_table_tone :: [(p,Double)] -> Double -> HS_R p
nearest_et_table_tone :: forall p. [(p, Cents)] -> Cents -> HS_R p
nearest_et_table_tone [(p, Cents)]
tbl Cents
f =
case forall s t. Ord s => [(t, s)] -> s -> Maybe ((t, s), (t, s))
bounds_et_table [(p, Cents)]
tbl Cents
f of
Maybe ((p, Cents), (p, Cents))
Nothing -> forall a. HasCallStack => String -> a
error String
"nearest_et_table_tone: no bounds?"
Just ((p
lp,Cents
lf),(p
rp,Cents
rf)) ->
let ld :: Cents
ld = Cents
f forall a. Num a => a -> a -> a
- Cents
lf
rd :: Cents
rd = Cents
f forall a. Num a => a -> a -> a
- Cents
rf
in if forall a. Num a => a -> a
abs Cents
ld forall a. Ord a => a -> a -> Bool
< forall a. Num a => a -> a
abs Cents
rd
then (Cents
f,p
lp,Cents
lf,Cents
ld,forall r n. (Real r, Floating n) => r -> n
fratio_to_cents (Cents
fforall a. Fractional a => a -> a -> a
/Cents
lf))
else (Cents
f,p
rp,Cents
rf,Cents
rd,forall r n. (Real r, Floating n) => r -> n
fratio_to_cents (Cents
fforall a. Fractional a => a -> a -> a
/Cents
rf))
nearest_12et_tone_k0 :: (Double,Double) -> Double -> HS_R Pitch
nearest_12et_tone_k0 :: (Cents, Cents) -> Cents -> HS_R Pitch
nearest_12et_tone_k0 (Cents, Cents)
zero = forall p. [(p, Cents)] -> Cents -> HS_R p
nearest_et_table_tone ((Cents, Cents) -> [(Pitch, Cents)]
tbl_12et_k0 (Cents, Cents)
zero)
nearest_24et_tone_k0 :: (Double,Double) -> Double -> HS_R Pitch
nearest_24et_tone_k0 :: (Cents, Cents) -> Cents -> HS_R Pitch
nearest_24et_tone_k0 (Cents, Cents)
zero = forall p. [(p, Cents)] -> Cents -> HS_R p
nearest_et_table_tone ((Cents, Cents) -> [(Pitch, Cents)]
tbl_24et_k0 (Cents, Cents)
zero)
alteration_72et_monzo :: Integral n => n -> String
alteration_72et_monzo :: forall n. Integral n => n -> String
alteration_72et_monzo n
n =
let spl :: String -> [String]
spl = forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
","
asc :: [String]
asc = String -> [String]
spl String
",+,>,^,#<,#-,#,#+,#>,#^"
dsc :: [String]
dsc = String -> [String]
spl String
",-,<,v,b>,b+,b,b-,b<,bv"
in case forall a. Ord a => a -> a -> Ordering
compare n
n n
0 of
Ordering
LT -> forall i a. Integral i => [a] -> i -> a
genericIndex [String]
dsc (- n
n)
Ordering
EQ -> String
""
Ordering
GT -> forall i a. Integral i => [a] -> i -> a
genericIndex [String]
asc n
n
pitch_72et_k0 :: (Double,Double) -> (Midi,Int) -> (Pitch_R,Double)
pitch_72et_k0 :: (Cents, Cents) -> OctPc -> (Pitch_R, Cents)
pitch_72et_k0 (Cents, Cents)
zero (Midi
x,Midi
n) =
let p :: Pitch
p = forall i. Integral i => i -> Pitch
midi_to_pitch_ks Midi
x
t :: Note
t = Pitch -> Note
note Pitch
p
a :: Alteration
a = Pitch -> Alteration
alteration Pitch
p
(Note
t',Midi
n') = case Alteration
a of
Alteration
Flat -> if Midi
n forall a. Ord a => a -> a -> Bool
< (-Midi
3) then (forall a. Enum a => a -> a
pred Note
t,Midi
n forall a. Num a => a -> a -> a
+ Midi
6) else (Note
t,Midi
n forall a. Num a => a -> a -> a
- Midi
6)
Alteration
Natural -> (Note
t,Midi
n)
Alteration
Sharp -> if Midi
n forall a. Ord a => a -> a -> Bool
> Midi
3 then (forall a. Enum a => a -> a
succ Note
t,Midi
n forall a. Num a => a -> a -> a
- Midi
6) else (Note
t,Midi
n forall a. Num a => a -> a -> a
+ Midi
6)
Alteration
_ -> forall a. HasCallStack => String -> a
error String
"pitch_72et: alteration?"
a' :: String
a' = forall n. Integral n => n -> String
alteration_72et_monzo Midi
n'
x' :: Cents
x' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Midi
x forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Midi
n forall a. Fractional a => a -> a -> a
/ Cents
6)
r :: (Pitch_R, Cents)
r = (Note -> Alteration_R -> Midi -> Pitch_R
Pitch_R Note
t' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Midi
n' forall a. Integral a => a -> a -> Ratio a
% Integer
12,String
a') (Pitch -> Midi
octave Pitch
p),forall a. Floating a => (a, a) -> a -> a
fmidi_to_cps_k0 (Cents, Cents)
zero Cents
x')
r' :: (Pitch_R, Cents)
r' = if Midi
n forall a. Ord a => a -> a -> Bool
> Midi
3
then (Cents, Cents) -> OctPc -> (Pitch_R, Cents)
pitch_72et_k0 (Cents, Cents)
zero (Midi
x forall a. Num a => a -> a -> a
+ Midi
1,Midi
n forall a. Num a => a -> a -> a
- Midi
6)
else if Midi
n forall a. Ord a => a -> a -> Bool
< (-Midi
3)
then (Cents, Cents) -> OctPc -> (Pitch_R, Cents)
pitch_72et_k0 (Cents, Cents)
zero (Midi
x forall a. Num a => a -> a -> a
- Midi
1,Midi
n forall a. Num a => a -> a -> a
+ Midi
6)
else (Pitch_R, Cents)
r
in case Alteration
a of
Alteration
Natural -> (Pitch_R, Cents)
r'
Alteration
_ -> (Pitch_R, Cents)
r
tbl_72et_k0 :: (Double, Double) -> [(Pitch_R,Double)]
tbl_72et_k0 :: (Cents, Cents) -> [(Pitch_R, Cents)]
tbl_72et_k0 (Cents, Cents)
zero =
let f :: Midi -> [(Pitch_R, Cents)]
f Midi
n = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry ((Cents, Cents) -> OctPc -> (Pitch_R, Cents)
pitch_72et_k0 (Cents, Cents)
zero)) (forall a. Midi -> a -> [a]
replicate Midi
6 Midi
n) [Midi
0..Midi
5]
in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Midi -> [(Pitch_R, Cents)]
f [Midi
12 .. Midi
143]
nearest_72et_tone_k0 :: (Double,Double) -> Double -> HS_R Pitch_R
nearest_72et_tone_k0 :: (Cents, Cents) -> Cents -> HS_R Pitch_R
nearest_72et_tone_k0 (Cents, Cents)
zero = forall p. [(p, Cents)] -> Cents -> HS_R p
nearest_et_table_tone ((Cents, Cents) -> [(Pitch_R, Cents)]
tbl_72et_k0 (Cents, Cents)
zero)
type Pitch_Detune = (Pitch,Cents)
hsr_to_pitch_detune :: HS_R Pitch -> Pitch_Detune
hsr_to_pitch_detune :: HS_R Pitch -> (Pitch, Cents)
hsr_to_pitch_detune (Cents
_,Pitch
p,Cents
_,Cents
_,Cents
c) = (Pitch
p,Cents
c)
nearest_pitch_detune_12et_k0 :: (Double, Double) -> Double -> Pitch_Detune
nearest_pitch_detune_12et_k0 :: (Cents, Cents) -> Cents -> (Pitch, Cents)
nearest_pitch_detune_12et_k0 (Cents, Cents)
zero = HS_R Pitch -> (Pitch, Cents)
hsr_to_pitch_detune forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cents, Cents) -> Cents -> HS_R Pitch
nearest_12et_tone_k0 (Cents, Cents)
zero
nearest_pitch_detune_24et_k0 :: (Double, Double) -> Double -> Pitch_Detune
nearest_pitch_detune_24et_k0 :: (Cents, Cents) -> Cents -> (Pitch, Cents)
nearest_pitch_detune_24et_k0 (Cents, Cents)
zero = HS_R Pitch -> (Pitch, Cents)
hsr_to_pitch_detune forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cents, Cents) -> Cents -> HS_R Pitch
nearest_24et_tone_k0 (Cents, Cents)
zero
ratio_to_pitch_detune :: (Double -> HS_R Pitch) -> OctPc -> Rational -> Pitch_Detune
ratio_to_pitch_detune :: (Cents -> HS_R Pitch) -> OctPc -> Ratio Integer -> (Pitch, Cents)
ratio_to_pitch_detune Cents -> HS_R Pitch
near_f OctPc
f0 Ratio Integer
r =
let f :: Cents
f = forall i n. (Integral i, Floating n) => Octave_PitchClass i -> n
octpc_to_cps OctPc
f0 forall a. Num a => a -> a -> a
* forall a b. (Real a, Fractional b) => a -> b
realToFrac Ratio Integer
r
(Cents
_,Pitch
p,Cents
_,Cents
_,Cents
c) = Cents -> HS_R Pitch
near_f Cents
f
in (Pitch
p,Cents
c)
pitch_detune_to_cps :: Floating n => Pitch_Detune -> n
pitch_detune_to_cps :: forall n. Floating n => (Pitch, Cents) -> n
pitch_detune_to_cps (Pitch
p,Cents
d) = forall a. Floating a => a -> a -> a
cps_shift_cents (forall n. Floating n => Pitch -> n
pitch_to_cps Pitch
p) (forall a b. (Real a, Fractional b) => a -> b
realToFrac Cents
d)
ratio_to_pitch_detune_12et_k0 :: (Double, Double) -> OctPc -> Rational -> Pitch_Detune
ratio_to_pitch_detune_12et_k0 :: (Cents, Cents) -> OctPc -> Ratio Integer -> (Pitch, Cents)
ratio_to_pitch_detune_12et_k0 (Cents, Cents)
zero = (Cents -> HS_R Pitch) -> OctPc -> Ratio Integer -> (Pitch, Cents)
ratio_to_pitch_detune ((Cents, Cents) -> Cents -> HS_R Pitch
nearest_12et_tone_k0 (Cents, Cents)
zero)
ratio_to_pitch_detune_24et_k0 :: (Double, Double) -> OctPc -> Rational -> Pitch_Detune
ratio_to_pitch_detune_24et_k0 :: (Cents, Cents) -> OctPc -> Ratio Integer -> (Pitch, Cents)
ratio_to_pitch_detune_24et_k0 (Cents, Cents)
zero = (Cents -> HS_R Pitch) -> OctPc -> Ratio Integer -> (Pitch, Cents)
ratio_to_pitch_detune ((Cents, Cents) -> Cents -> HS_R Pitch
nearest_24et_tone_k0 (Cents, Cents)
zero)
pitch_detune_in_octave_nearest :: Pitch -> Pitch_Detune -> Pitch_Detune
pitch_detune_in_octave_nearest :: Pitch -> (Pitch, Cents) -> (Pitch, Cents)
pitch_detune_in_octave_nearest Pitch
p1 (Pitch
p2,Cents
d2) = (Pitch -> Pitch -> Pitch
pitch_in_octave_nearest Pitch
p1 Pitch
p2,Cents
d2)
pitch_detune_md :: Pitch_Detune -> String
pitch_detune_md :: (Pitch, Cents) -> String
pitch_detune_md (Pitch
p,Cents
c) = Pitch -> String
pitch_pp Pitch
p forall a. [a] -> [a] -> [a]
++ forall a. (Num a, Ord a, Show a) => a -> String
cents_diff_md (forall a b. (RealFrac a, Integral b) => a -> b
round Cents
c :: Integer)
pitch_detune_html :: Pitch_Detune -> String
pitch_detune_html :: (Pitch, Cents) -> String
pitch_detune_html (Pitch
p,Cents
c) = Pitch -> String
pitch_pp Pitch
p forall a. [a] -> [a] -> [a]
++ forall a. (Num a, Ord a, Show a) => a -> String
cents_diff_html (forall a b. (RealFrac a, Integral b) => a -> b
round Cents
c :: Integer)
pitch_class_detune_md :: Pitch_Detune -> String
pitch_class_detune_md :: (Pitch, Cents) -> String
pitch_class_detune_md (Pitch
p,Cents
c) = Pitch -> String
pitch_class_pp Pitch
p forall a. [a] -> [a] -> [a]
++ forall a. (Num a, Ord a, Show a) => a -> String
cents_diff_md (forall a b. (RealFrac a, Integral b) => a -> b
round Cents
c :: Integer)
pitch_class_detune_html :: Pitch_Detune -> String
pitch_class_detune_html :: (Pitch, Cents) -> String
pitch_class_detune_html (Pitch
p,Cents
c) = Pitch -> String
pitch_class_pp Pitch
p forall a. [a] -> [a] -> [a]
++ forall a. (Num a, Ord a, Show a) => a -> String
cents_diff_html (forall a b. (RealFrac a, Integral b) => a -> b
round Cents
c :: Integer)