module Music.Theory.Pitch.Spelling.Key where
import qualified Music.Theory.Key as T
import qualified Music.Theory.Pitch as T
import qualified Music.Theory.Pitch.Note as T
import qualified Music.Theory.Pitch.Spelling.Table as T
pcset_spell_implied_key_f :: Integral i => [i] -> Maybe (T.Spelling i)
pcset_spell_implied_key_f :: forall i. Integral i => [i] -> Maybe (Spelling i)
pcset_spell_implied_key_f [i]
x =
case forall i. Integral i => Mode -> [i] -> Maybe PitchClass
T.implied_fifths Mode
T.Major_Mode [i]
x of
Maybe PitchClass
Nothing -> forall a. Maybe a
Nothing
Just PitchClass
n -> if PitchClass
n forall a. Eq a => a -> a -> Bool
== PitchClass
0
then forall a. a -> Maybe a
Just forall i. Integral i => Spelling i
T.pc_spell_natural
else if PitchClass
n forall a. Ord a => a -> a -> Bool
< PitchClass
0
then forall a. a -> Maybe a
Just forall i. Integral i => Spelling i
T.pc_spell_flat
else forall a. a -> Maybe a
Just forall i. Integral i => Spelling i
T.pc_spell_sharp
pcset_spell_implied_key :: Integral i => [i] -> Maybe [(T.Note, T.Alteration)]
pcset_spell_implied_key :: forall i. Integral i => [i] -> Maybe [(Note, Alteration)]
pcset_spell_implied_key [i]
x =
case forall i. Integral i => [i] -> Maybe (Spelling i)
pcset_spell_implied_key_f [i]
x of
Just Spelling i
f -> forall a. a -> Maybe a
Just (forall a b. (a -> b) -> [a] -> [b]
map Spelling i
f [i]
x)
Maybe (Spelling i)
Nothing -> forall a. Maybe a
Nothing
octpc_spell_implied_key :: [T.OctPc] -> Maybe [T.Pitch]
octpc_spell_implied_key :: [OctPc] -> Maybe [Pitch]
octpc_spell_implied_key [OctPc]
x =
let f :: PitchClass -> (Note, Alteration) -> Pitch
f PitchClass
o (Note
n,Alteration
a) = Note -> Alteration -> PitchClass -> Pitch
T.Pitch Note
n Alteration
a PitchClass
o
in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PitchClass -> (Note, Alteration) -> Pitch
f (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [OctPc]
x)) (forall i. Integral i => [i] -> Maybe [(Note, Alteration)]
pcset_spell_implied_key (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [OctPc]
x))
midi_spell_implied_key :: [T.Midi] -> Maybe [T.Pitch]
midi_spell_implied_key :: [PitchClass] -> Maybe [Pitch]
midi_spell_implied_key = [OctPc] -> Maybe [Pitch]
octpc_spell_implied_key forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PitchClass -> OctPc
T.midi_to_octpc