-- | Common music notation pitch values.
module Music.Theory.Pitch where

import Data.Char {- base -}
import Data.Function {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}
import Text.Printf {- base -}

import qualified Text.Parsec as P {- parsec -}

import qualified Music.Theory.List as T {- hmt -}
import qualified Music.Theory.Math as T {- hmt -}
import qualified Music.Theory.Math.Convert as T {- hmt -}
import qualified Music.Theory.Parse as T {- hmt -}
import qualified Music.Theory.Pitch.Note as T {- hmt -}
import qualified Music.Theory.Show as T {- hmt -}
import qualified Music.Theory.Tuning as T {- hmt -}

-- * Octave pitch-class (generic)

-- | 'Octave' and 'PitchClass' duple.
type Octave_PitchClass i = (i,i)

-- | Normalise 'Octave_PitchClass' value, ie. ensure pitch-class is in (0,11).
octave_pitchclass_nrm :: (Ord i,Num i) => Octave_PitchClass i -> Octave_PitchClass i
octave_pitchclass_nrm :: forall i.
(Ord i, Num i) =>
Octave_PitchClass i -> Octave_PitchClass i
octave_pitchclass_nrm (i
o,i
pc) =
    if i
pc forall a. Ord a => a -> a -> Bool
> i
11
    then forall i.
(Ord i, Num i) =>
Octave_PitchClass i -> Octave_PitchClass i
octave_pitchclass_nrm (i
oforall a. Num a => a -> a -> a
+i
1,i
pcforall a. Num a => a -> a -> a
-i
12)
    else if i
pc forall a. Ord a => a -> a -> Bool
< i
0
         then forall i.
(Ord i, Num i) =>
Octave_PitchClass i -> Octave_PitchClass i
octave_pitchclass_nrm (i
oforall a. Num a => a -> a -> a
-i
1,i
pcforall a. Num a => a -> a -> a
+i
12)
         else (i
o,i
pc)

-- | Transpose 'Octave_PitchClass' value.
octave_pitchclass_trs :: Integral i => i -> Octave_PitchClass i -> Octave_PitchClass i
octave_pitchclass_trs :: forall i.
Integral i =>
i -> Octave_PitchClass i -> Octave_PitchClass i
octave_pitchclass_trs i
n (i
o,i
pc) =
    let k :: i
k = i
pc forall a. Num a => a -> a -> a
+ i
n
        (i
i,i
j) = i
k forall a. Integral a => a -> a -> (a, a)
`divMod` i
12
    in (i
o forall a. Num a => a -> a -> a
+ i
i,i
j)

-- | 'Octave_PitchClass' value to integral /midi/ note number.
--
-- > map octave_pitchclass_to_midi [(-1,9),(8,0)] == map (+ 9) [0,99]
octave_pitchclass_to_midi :: Num i => Octave_PitchClass i -> i
octave_pitchclass_to_midi :: forall i. Num i => Octave_PitchClass i -> i
octave_pitchclass_to_midi (i
o,i
pc) = i
60 forall a. Num a => a -> a -> a
+ ((i
o forall a. Num a => a -> a -> a
- i
4) forall a. Num a => a -> a -> a
* i
12) forall a. Num a => a -> a -> a
+ i
pc

-- | Inverse of 'octave_pitchclass_to_midi'.
--
-- > map midi_to_octave_pitchclass [0,36,60,84,91] == [(-1,0),(2,0),(4,0),(6,0),(6,7)]
midi_to_octave_pitchclass :: (Integral m,Integral i) => m -> Octave_PitchClass i
midi_to_octave_pitchclass :: forall m i. (Integral m, Integral i) => m -> Octave_PitchClass i
midi_to_octave_pitchclass m
n = (forall a b. (Integral a, Num b) => a -> b
fromIntegral m
n forall a. Num a => a -> a -> a
- i
12) forall a. Integral a => a -> a -> (a, a)
`divMod` i
12

{- | One-indexed piano key number (for standard 88 key piano) to pitch class.
     This has the mnemonic that 49 maps to (4,9).

> map pianokey_to_octave_pitchclass [1,49,88] == [(0,9),(4,9),(8,0)]
-}
pianokey_to_octave_pitchclass :: (Integral m,Integral i) => m -> Octave_PitchClass i
pianokey_to_octave_pitchclass :: forall m i. (Integral m, Integral i) => m -> Octave_PitchClass i
pianokey_to_octave_pitchclass = forall m i. (Integral m, Integral i) => m -> Octave_PitchClass i
midi_to_octave_pitchclass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
(+) m
20

-- * Octave & PitchClass

-- | Pitch classes are modulo twelve integers (0-11)
type PitchClass = Int

-- | Octaves are integers, the octave of middle C is @4@.
type Octave = Int

-- | 'Octave' and 'PitchClass' duple.
type OctPc = (Octave,PitchClass)

-- | Translate from generic octave & pitch-class duple.
octave_pitchclass_to_octpc :: (Integral pc, Integral oct) => (oct,pc) -> OctPc
octave_pitchclass_to_octpc :: forall pc oct. (Integral pc, Integral oct) => (oct, pc) -> OctPc
octave_pitchclass_to_octpc (oct
oct,pc
pc) = (forall a b. (Integral a, Num b) => a -> b
fromIntegral oct
oct,forall a b. (Integral a, Num b) => a -> b
fromIntegral pc
pc)

-- | Normalise 'OctPc'.
--
-- > octpc_nrm (4,16) == (5,4)
octpc_nrm :: OctPc -> OctPc
octpc_nrm :: OctPc -> OctPc
octpc_nrm = forall i.
(Ord i, Num i) =>
Octave_PitchClass i -> Octave_PitchClass i
octave_pitchclass_nrm

-- | Transpose 'OctPc'.
--
-- > octpc_trs 7 (4,9) == (5,4)
-- > octpc_trs (-11) (4,9) == (3,10)
octpc_trs :: Int -> OctPc -> OctPc
octpc_trs :: Octave -> OctPc -> OctPc
octpc_trs = forall i.
Integral i =>
i -> Octave_PitchClass i -> Octave_PitchClass i
octave_pitchclass_trs

-- | Enumerate range, inclusive.
--
-- > octpc_range ((3,8),(4,1)) == [(3,8),(3,9),(3,10),(3,11),(4,0),(4,1)]
octpc_range :: (OctPc,OctPc) -> [OctPc]
octpc_range :: (OctPc, OctPc) -> [OctPc]
octpc_range (OctPc
l,OctPc
r) =
    let (Octave
l',Octave
r') = (OctPc -> Octave
octpc_to_midi OctPc
l,OctPc -> Octave
octpc_to_midi OctPc
r)
    in forall a b. (a -> b) -> [a] -> [b]
map Octave -> OctPc
midi_to_octpc [Octave
l' .. Octave
r']

-- * Midi note number (0 - 127)

{- | Midi note number (0 - 127).
     Midi data values are unsigned 7-bit integers, however using an unsigned type would be problematic.
     It would make transposition, for instance, awkward.
     x - 12 would transpose down an octave, but the transposition interval itself could not be negative.
-}
type Midi = Int

-- | Type conversion
midi_to_int :: Midi -> Int
midi_to_int :: Octave -> Octave
midi_to_int = forall a. a -> a
id

-- | Type-specialise /f/, ie. round, ceiling, truncate
double_to_midi :: (Double -> Midi) -> Double -> Midi
double_to_midi :: (Double -> Octave) -> Double -> Octave
double_to_midi = (Double -> Octave) -> Double -> Octave
T.double_to_int

-- | 'OctPc' value to integral /midi/ note number.
--
-- > map octpc_to_midi [(0,0),(2,6),(4,9),(6,2),(9,0)] == [12,42,69,86,120]
-- > map octpc_to_midi [(0,9),(8,0)] == [21,108]
octpc_to_midi :: OctPc -> Midi
octpc_to_midi :: OctPc -> Octave
octpc_to_midi = forall i. Num i => Octave_PitchClass i -> i
octave_pitchclass_to_midi

-- | Inverse of 'octpc_to_midi'.
--
-- > map midi_to_octpc [40,69] == [(2,4),(4,9)]
midi_to_octpc :: Midi -> OctPc
midi_to_octpc :: Octave -> OctPc
midi_to_octpc = forall m i. (Integral m, Integral i) => m -> Octave_PitchClass i
midi_to_octave_pitchclass

-- * Octave & fractional pitch-class

-- | (octave,pitch-class) to fractional octave.
--   This is an odd notation, but can be useful for writing pitch data where a float is required.
--   Note this is not a linear octave, for that see 'Sound.SC3.Common.Math.oct_to_cps'.
--
-- > map octpc_to_foct [(4,0),(4,7),(5,11)] == [4.00,4.07,5.11]
octpc_to_foct :: (Integral i, Fractional r) => (i,i) -> r
octpc_to_foct :: forall i r. (Integral i, Fractional r) => (i, i) -> r
octpc_to_foct (i
o,i
pc) = forall a b. (Integral a, Num b) => a -> b
fromIntegral i
o forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral i
pc forall a. Fractional a => a -> a -> a
/ r
100)

-- | Inverse of 'octpc_to_foct'.
--
-- > map foct_to_octpc [3.11,4.00,4.07,5.11] == [(3,11),(4,0),(4,7),(5,11)]
foct_to_octpc :: (Integral i, RealFrac r) => r -> (i,i)
foct_to_octpc :: forall i r. (Integral i, RealFrac r) => r -> (i, i)
foct_to_octpc r
x =
  let (i
p,r
q) = forall i t. (Integral i, RealFrac t) => t -> (i, t)
T.integral_and_fractional_parts r
x
  in (i
p,forall a b. (RealFrac a, Integral b) => a -> b
round (r
q forall a. Num a => a -> a -> a
* r
100))

-- | 'octpc_to_midi' of 'foct_to_octpc'.
foct_to_midi :: (Integral i, RealFrac r) => r -> i
foct_to_midi :: forall i r. (Integral i, RealFrac r) => r -> i
foct_to_midi = forall i. Num i => Octave_PitchClass i -> i
octave_pitchclass_to_midi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i r. (Integral i, RealFrac r) => r -> (i, i)
foct_to_octpc

-- * FMIDI

-- | Fractional midi note number.
type FMidi = Double

-- | Fractional octave pitch-class (octave is integral, pitch-class is fractional).
type FOctPc = (Int,Double)

-- | 'fromIntegral' of 'octpc_to_midi'.
octpc_to_fmidi :: (Integral i,Num n) => Octave_PitchClass i -> n
octpc_to_fmidi :: forall i n. (Integral i, Num n) => Octave_PitchClass i -> n
octpc_to_fmidi = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Num i => Octave_PitchClass i -> i
octave_pitchclass_to_midi

-- | Fractional midi to fractional octave pitch-class.
--
-- > fmidi_to_foctpc 69.5 == (4,9.5)
fmidi_to_foctpc :: RealFrac f => f -> (Octave,f)
fmidi_to_foctpc :: forall f. RealFrac f => f -> (Octave, f)
fmidi_to_foctpc f
n = let o :: Octave
o = (forall a b. (RealFrac a, Integral b) => a -> b
floor f
n forall a. Num a => a -> a -> a
- Octave
12) forall a. Integral a => a -> a -> a
`div` Octave
12 in (Octave
o,f
n forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Octave
o forall a. Num a => a -> a -> a
+ Octave
1) forall a. Num a => a -> a -> a
* f
12))

-- | Octave of fractional midi note number.
fmidi_octave :: RealFrac f => f -> Octave
fmidi_octave :: forall f. RealFrac f => f -> Octave
fmidi_octave = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f. RealFrac f => f -> (Octave, f)
fmidi_to_foctpc

foctpc_to_fmidi :: RealFrac f => (Octave,f) -> f
foctpc_to_fmidi :: forall f. RealFrac f => (Octave, f) -> f
foctpc_to_fmidi (Octave
o,f
pc) = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Octave
o forall a. Num a => a -> a -> a
+ Octave
1) forall a. Num a => a -> a -> a
* f
12) forall a. Num a => a -> a -> a
+ f
pc

-- | Move fractional midi note number to indicated octave.
--
-- > map (fmidi_in_octave 1) [59.5,60.5] == [35.5,24.5]
fmidi_in_octave :: RealFrac f => Octave -> f -> f
fmidi_in_octave :: forall f. RealFrac f => Octave -> f -> f
fmidi_in_octave Octave
o f
m = let (Octave
_,f
pc) = forall f. RealFrac f => f -> (Octave, f)
fmidi_to_foctpc f
m in forall f. RealFrac f => (Octave, f) -> f
foctpc_to_fmidi (Octave
o,f
pc)

-- | Print fractional midi note number as ET12 pitch with cents detune in parentheses.
--
-- > fmidi_et12_cents_pp T.pc_spell_ks 66.5 == "F♯4(+50)"
fmidi_et12_cents_pp :: Spelling PitchClass -> FMidi -> String
fmidi_et12_cents_pp :: Spelling Octave -> Double -> String
fmidi_et12_cents_pp Spelling Octave
sp =
    let f :: (i, b) -> String
f (i
m,b
c) =
            let d :: String
d = forall a. (Num a, Ord a, Show a) => a -> String
T.num_diff_str (forall a b. (RealFrac a, Integral b) => a -> b
round b
c :: Int)
                d' :: String
d' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d then String
"" else String
"(" forall a. [a] -> [a] -> [a]
++ String
d forall a. [a] -> [a] -> [a]
++ String
")"
            in Pitch -> String
pitch_pp (forall i k. (Integral i, Integral k) => Spelling k -> i -> Pitch
midi_to_pitch Spelling Octave
sp i
m) forall a. [a] -> [a] -> [a]
++ String
d'
    in forall {i} {b}. (Integral i, RealFrac b) => (i, b) -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m c. (Num m, Ord c, Num c) => (m, c) -> (m, c)
midi_detune_normalise forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> (Octave, Double)
fmidi_to_midi_detune

-- * Pitch

-- | Common music notation pitch value.
data Pitch = Pitch {Pitch -> Note
note :: T.Note
                   ,Pitch -> Alteration
alteration :: T.Alteration
                   ,Pitch -> Octave
octave :: Octave}
           deriving (Pitch -> Pitch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pitch -> Pitch -> Bool
$c/= :: Pitch -> Pitch -> Bool
== :: Pitch -> Pitch -> Bool
$c== :: Pitch -> Pitch -> Bool
Eq,Octave -> Pitch -> ShowS
[Pitch] -> ShowS
Pitch -> String
forall a.
(Octave -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pitch] -> ShowS
$cshowList :: [Pitch] -> ShowS
show :: Pitch -> String
$cshow :: Pitch -> String
showsPrec :: Octave -> Pitch -> ShowS
$cshowsPrec :: Octave -> Pitch -> ShowS
Show)

instance Ord Pitch where
    compare :: Pitch -> Pitch -> Ordering
compare = Pitch -> Pitch -> Ordering
pitch_compare

-- | Simplify 'Pitch' to standard 12ET by deleting quarter tones.
--
-- > let p = Pitch T.A T.QuarterToneSharp 4
-- > alteration (pitch_clear_quarter_tone p) == T.Sharp
pitch_clear_quarter_tone :: Pitch -> Pitch
pitch_clear_quarter_tone :: Pitch -> Pitch
pitch_clear_quarter_tone Pitch
p =
    let Pitch Note
n Alteration
a Octave
o = Pitch
p
    in Note -> Alteration -> Octave -> Pitch
Pitch Note
n (Alteration -> Alteration
T.alteration_clear_quarter_tone Alteration
a) Octave
o

-- | 'Pitch' to 'Octave' and 'PitchClass' notation.
--
-- > pitch_to_octpc (Pitch F Sharp 4) == (4,6)
pitch_to_octpc :: Integral i => Pitch -> Octave_PitchClass i
pitch_to_octpc :: forall i. Integral i => Pitch -> Octave_PitchClass i
pitch_to_octpc = forall m i. (Integral m, Integral i) => m -> Octave_PitchClass i
midi_to_octave_pitchclass forall b c a. (b -> c) -> (a -> b) -> a -> c
. Octave -> Octave
T.int_id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Pitch -> i
pitch_to_midi

-- | Is 'Pitch' 12-ET.
pitch_is_12et :: Pitch -> Bool
pitch_is_12et :: Pitch -> Bool
pitch_is_12et = Alteration -> Bool
T.alteration_is_12et forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch -> Alteration
alteration

-- | 'Pitch' to midi note number notation.
--
-- > pitch_to_midi (Pitch A Natural 4) == 69
pitch_to_midi :: Integral i => Pitch -> i
pitch_to_midi :: forall i. Integral i => Pitch -> i
pitch_to_midi (Pitch Note
n Alteration
a Octave
o) =
    let a' :: i
a' = forall i. Integral i => Alteration -> i
T.alteration_to_diff_err Alteration
a
        n' :: i
n' = forall i. Num i => Note -> i
T.note_to_pc Note
n
        o' :: i
o' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Octave
o
    in i
12 forall a. Num a => a -> a -> a
+ i
o' forall a. Num a => a -> a -> a
* i
12 forall a. Num a => a -> a -> a
+ i
n' forall a. Num a => a -> a -> a
+ i
a'

-- | 'Pitch' to fractional midi note number notation.
--
-- > pitch_to_fmidi (Pitch A QuarterToneSharp 4) == 69.5
pitch_to_fmidi :: Fractional n => Pitch -> n
pitch_to_fmidi :: forall n. Fractional n => Pitch -> n
pitch_to_fmidi (Pitch Note
n Alteration
a Octave
o) =
    let a' :: n
a' = forall n. Fractional n => Alteration -> n
T.alteration_to_fdiff Alteration
a
        o' :: n
o' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Octave
o
        n' :: n
n' = forall a. Num a => Integer -> a
fromInteger (forall i. Num i => Note -> i
T.note_to_pc Note
n)
    in n
12 forall a. Num a => a -> a -> a
+ n
o' forall a. Num a => a -> a -> a
* n
12 forall a. Num a => a -> a -> a
+ n
n' forall a. Num a => a -> a -> a
+ n
a'

-- | Extract 'PitchClass' of 'Pitch'
--
-- > map pitch_to_pc [Pitch A Natural 4,Pitch F Sharp 4] == [9,6]
-- > map pitch_to_pc [Pitch C Flat 4,Pitch B Sharp 5] == [11,0]
pitch_to_pc :: Pitch -> PitchClass
pitch_to_pc :: Pitch -> Octave
pitch_to_pc (Pitch Note
n Alteration
a Octave
_) = (forall i. Num i => Note -> i
T.note_to_pc Note
n forall a. Num a => a -> a -> a
+ forall i. Integral i => Alteration -> i
T.alteration_to_diff_err Alteration
a) forall a. Integral a => a -> a -> a
`mod` Octave
12

-- | 'Pitch' comparison, implemented via 'pitch_to_fmidi'.
--
-- > pitch_compare (Pitch A Natural 4) (Pitch A QuarterToneSharp 4) == LT
pitch_compare :: Pitch -> Pitch -> Ordering
pitch_compare :: Pitch -> Pitch -> Ordering
pitch_compare =
    let f :: Pitch -> Double
f = forall n. Fractional n => Pitch -> n
pitch_to_fmidi :: Pitch -> Double
    in forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Pitch -> Double
f

-- * Spelling

-- | Function to spell a 'PitchClass'.
type Spelling n = n -> (T.Note,T.Alteration)

-- | Variant of 'Spelling' for incomplete functions.
type Spelling_M i = i -> Maybe (T.Note,T.Alteration)

-- | Given 'Spelling' function translate from 'OctPc' notation to 'Pitch'.
--
-- > octpc_to_pitch T.pc_spell_sharp (4,6) == Pitch T.F T.Sharp 4
octpc_to_pitch :: Integral i => Spelling i -> Octave_PitchClass i -> Pitch
octpc_to_pitch :: forall i. Integral i => Spelling i -> Octave_PitchClass i -> Pitch
octpc_to_pitch Spelling i
sp (i
o,i
pc) =
    let (Note
n,Alteration
a) = Spelling i
sp i
pc
    in Note -> Alteration -> Octave -> Pitch
Pitch Note
n Alteration
a (forall a b. (Integral a, Num b) => a -> b
fromIntegral i
o)

-- | Midi note number to 'Pitch'.
--
-- > import Music.Theory.Pitch.Spelling.Table as T
-- > let r = ["C4","E♭4","F♯4"]
-- > map (pitch_pp . midi_to_pitch T.pc_spell_ks) [60,63,66] == r
midi_to_pitch :: (Integral i,Integral k) => Spelling k -> i -> Pitch
midi_to_pitch :: forall i k. (Integral i, Integral k) => Spelling k -> i -> Pitch
midi_to_pitch Spelling k
sp = forall i. Integral i => Spelling i -> Octave_PitchClass i -> Pitch
octpc_to_pitch Spelling k
sp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m i. (Integral m, Integral i) => m -> Octave_PitchClass i
midi_to_octave_pitchclass

{- | Fractional midi note number to 'Pitch'.

> p = Pitch T.B T.ThreeQuarterToneFlat 4
> map (fmidi_to_pitch T.pc_spell_ks) [69.25,69.5] == [Nothing,Just p]
-}
fmidi_to_pitch :: RealFrac n => Spelling PitchClass -> n -> Maybe Pitch
fmidi_to_pitch :: forall n. RealFrac n => Spelling Octave -> n -> Maybe Pitch
fmidi_to_pitch Spelling Octave
sp n
m =
    let m' :: Octave
m' = forall r. Real r => r -> Octave
T.real_round_int n
m
        (Pitch Note
n Alteration
a Octave
o) = forall i k. (Integral i, Integral k) => Spelling k -> i -> Pitch
midi_to_pitch Spelling Octave
sp Octave
m'
        q :: n
q = n
m forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Octave
m'
    in case forall n.
(Fractional n, Eq n) =>
n -> Alteration -> Maybe Alteration
T.alteration_edit_quarter_tone n
q Alteration
a of
         Maybe Alteration
Nothing -> forall a. Maybe a
Nothing
         Just Alteration
a' -> forall a. a -> Maybe a
Just (Note -> Alteration -> Octave -> Pitch
Pitch Note
n Alteration
a' Octave
o)

-- | Erroring variant.
--
-- > import Music.Theory.Pitch.Spelling as T
-- > pitch_pp (fmidi_to_pitch_err T.pc_spell_ks 65.5) == "F𝄲4"
-- > pitch_pp (fmidi_to_pitch_err T.pc_spell_ks 66.5) == "F𝄰4"
-- > pitch_pp (fmidi_to_pitch_err T.pc_spell_ks 67.5) == "A𝄭4"
-- > pitch_pp (fmidi_to_pitch_err T.pc_spell_ks 69.5) == "B𝄭4"
fmidi_to_pitch_err :: (Show n,RealFrac n) => Spelling Int -> n -> Pitch
fmidi_to_pitch_err :: forall n. (Show n, RealFrac n) => Spelling Octave -> n -> Pitch
fmidi_to_pitch_err Spelling Octave
sp n
m = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (forall a. Show a => a -> String
show (String
"fmidi_to_pitch",n
m))) (forall n. RealFrac n => Spelling Octave -> n -> Maybe Pitch
fmidi_to_pitch Spelling Octave
sp n
m)

-- | Composition of 'pitch_to_fmidi' and then 'fmidi_to_pitch'.
--
-- > import Music.Theory.Pitch.Name as T
-- > import Music.Theory.Pitch.Spelling as T
-- > pitch_transpose_fmidi T.pc_spell_ks 2 T.ees5 == T.f5
pitch_transpose_fmidi :: (RealFrac n,Show n) => Spelling Int -> n -> Pitch -> Pitch
pitch_transpose_fmidi :: forall n.
(RealFrac n, Show n) =>
Spelling Octave -> n -> Pitch -> Pitch
pitch_transpose_fmidi Spelling Octave
sp n
n Pitch
p =
    let m :: n
m = forall n. Fractional n => Pitch -> n
pitch_to_fmidi Pitch
p
    in forall n. (Show n, RealFrac n) => Spelling Octave -> n -> Pitch
fmidi_to_pitch_err Spelling Octave
sp (n
m forall a. Num a => a -> a -> a
+ n
n)

-- | Displacement of /q/ into octave of /p/.
fmidi_in_octave_of :: RealFrac f => f -> f -> f
fmidi_in_octave_of :: forall f. RealFrac f => f -> f -> f
fmidi_in_octave_of f
p = forall f. RealFrac f => Octave -> f -> f
fmidi_in_octave (forall f. RealFrac f => f -> Octave
fmidi_octave f
p)

-- | Octave displacement of /m2/ that is nearest /m1/.
--
-- > let p = octpc_to_fmidi (2,1)
-- > let q = map octpc_to_fmidi [(4,11),(4,0),(4,1)]
-- > map (fmidi_in_octave_nearest p) q == [35,36,37]
fmidi_in_octave_nearest :: RealFrac n => n -> n -> n
fmidi_in_octave_nearest :: forall f. RealFrac f => f -> f -> f
fmidi_in_octave_nearest n
m1 n
m2 =
    let m2' :: n
m2' = forall f. RealFrac f => Octave -> f -> f
fmidi_in_octave (forall f. RealFrac f => f -> Octave
fmidi_octave n
m1) n
m2
        m2'' :: [n]
m2'' = [n
m2' forall a. Num a => a -> a -> a
- n
12,n
m2',n
m2' forall a. Num a => a -> a -> a
+ n
12]
        d :: [n]
d = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n
m1 forall a. Num a => a -> a -> a
-)) [n]
m2''
        z :: [(n, n)]
z = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> b
snd (forall a b. [a] -> [b] -> [(a, b)]
zip [n]
m2'' [n]
d)
    in forall a b. (a, b) -> a
fst (forall a. [a] -> a
head [(n, n)]
z)

-- | Displacement of /q/ into octave above /p/.
--
-- > fmidi_in_octave_of 69 51 == 63
-- > fmidi_in_octave_nearest 69 51 == 63
-- > fmidi_in_octave_above 69 51 == 75
fmidi_in_octave_above :: RealFrac a => a -> a -> a
fmidi_in_octave_above :: forall f. RealFrac f => f -> f -> f
fmidi_in_octave_above a
p a
q = let r :: a
r = forall f. RealFrac f => f -> f -> f
fmidi_in_octave_nearest a
p a
q in if a
r forall a. Ord a => a -> a -> Bool
< a
p then a
r forall a. Num a => a -> a -> a
+ a
12 else a
r

-- | Displacement of /q/ into octave below /p/.
--
-- > fmidi_in_octave_of 69 85 == 61
-- > fmidi_in_octave_nearest 69 85 == 73
-- > fmidi_in_octave_below 69 85 == 61
fmidi_in_octave_below :: RealFrac a => a -> a -> a
fmidi_in_octave_below :: forall f. RealFrac f => f -> f -> f
fmidi_in_octave_below a
p a
q = let r :: a
r = forall f. RealFrac f => f -> f -> f
fmidi_in_octave_nearest a
p a
q in if a
r forall a. Ord a => a -> a -> Bool
> a
p then a
r forall a. Num a => a -> a -> a
- a
12 else a
r

-- | CPS form of binary /fmidi/ function /f/.
lift_fmidi_binop_to_cps :: Floating f => (f -> f -> f) -> f -> f -> f
lift_fmidi_binop_to_cps :: forall f. Floating f => (f -> f -> f) -> f -> f -> f
lift_fmidi_binop_to_cps f -> f -> f
f f
p = forall a. Floating a => a -> a
T.fmidi_to_cps forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> f -> f
f (forall a. Floating a => a -> a
cps_to_fmidi f
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
cps_to_fmidi

-- | CPS form of 'fmidi_in_octave_nearest'.
--
-- > map cps_octave [440,256] == [4,4]
-- > round (cps_in_octave_nearest 440 256) == 512
cps_in_octave_nearest :: (Floating f,RealFrac f) => f -> f -> f
cps_in_octave_nearest :: forall f. (Floating f, RealFrac f) => f -> f -> f
cps_in_octave_nearest = forall f. Floating f => (f -> f -> f) -> f -> f -> f
lift_fmidi_binop_to_cps forall f. RealFrac f => f -> f -> f
fmidi_in_octave_nearest

-- | CPS form of 'fmidi_in_octave_above'.
--
-- > cps_in_octave_above 55.0 392.0 == 97.99999999999999
cps_in_octave_above :: (Floating f,RealFrac f) => f -> f -> f
cps_in_octave_above :: forall f. (Floating f, RealFrac f) => f -> f -> f
cps_in_octave_above = forall f. Floating f => (f -> f -> f) -> f -> f -> f
lift_fmidi_binop_to_cps forall f. RealFrac f => f -> f -> f
fmidi_in_octave_above

-- | CPS form of 'fmidi_in_octave_above'.
cps_in_octave_below :: (Floating f,RealFrac f) => f -> f -> f
cps_in_octave_below :: forall f. (Floating f, RealFrac f) => f -> f -> f
cps_in_octave_below = forall f. Floating f => (f -> f -> f) -> f -> f -> f
lift_fmidi_binop_to_cps forall f. RealFrac f => f -> f -> f
fmidi_in_octave_below

-- | Direct implementation of 'cps_in_octave_above'.
--   Raise or lower the frequency /q/ by octaves until it is in the
--   octave starting at /p/.
--
-- > cps_in_octave_above_direct 55.0 392.0 == 98.0
cps_in_octave_above_direct :: (Ord a, Fractional a) => a -> a -> a
cps_in_octave_above_direct :: forall a. (Ord a, Fractional a) => a -> a -> a
cps_in_octave_above_direct a
p a
q =
  let f :: a -> a
f = forall a. (Ord a, Fractional a) => a -> a -> a
cps_in_octave_above_direct a
p
  in if a
q forall a. Ord a => a -> a -> Bool
> a
p forall a. Num a => a -> a -> a
* a
2 then a -> a
f (a
q forall a. Fractional a => a -> a -> a
/ a
2) else if a
q forall a. Ord a => a -> a -> Bool
< a
p then a -> a
f (a
q forall a. Num a => a -> a -> a
* a
2) else a
q

-- | Set octave of /p2/ so that it nearest to /p1/.
--
-- > import Music.Theory.Pitch
-- > import Music.Theory.Pitch.Name as T
-- > let r = ["B1","C2","C#2"]
-- > let f = pitch_in_octave_nearest T.cis2
-- > map (pitch_pp_iso . f) [T.b4,T.c4,T.cis4] == r
pitch_in_octave_nearest :: Pitch -> Pitch -> Pitch
pitch_in_octave_nearest :: Pitch -> Pitch -> Pitch
pitch_in_octave_nearest Pitch
p1 Pitch
p2 =
    let f :: Pitch -> Double
f = forall n. Fractional n => Pitch -> n
pitch_to_fmidi :: Pitch -> Double
        o :: Octave
o = forall f. RealFrac f => f -> Octave
fmidi_octave (forall f. RealFrac f => f -> f -> f
fmidi_in_octave_nearest (Pitch -> Double
f Pitch
p1) (Pitch -> Double
f Pitch
p2))
    in Pitch
p2 {octave :: Octave
octave = Octave
o}

-- | Raise 'Note' of 'Pitch', account for octave transposition.
--
-- > pitch_note_raise (Pitch B Natural 3) == Pitch C Natural 4
pitch_note_raise :: Pitch -> Pitch
pitch_note_raise :: Pitch -> Pitch
pitch_note_raise (Pitch Note
n Alteration
a Octave
o) =
    if Note
n forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
maxBound
    then Note -> Alteration -> Octave -> Pitch
Pitch forall a. Bounded a => a
minBound Alteration
a (Octave
o forall a. Num a => a -> a -> a
+ Octave
1)
    else Note -> Alteration -> Octave -> Pitch
Pitch (forall a. Enum a => a -> a
succ Note
n) Alteration
a Octave
o

-- | Lower 'Note' of 'Pitch', account for octave transposition.
--
-- > pitch_note_lower (Pitch C Flat 4) == Pitch B Flat 3
pitch_note_lower :: Pitch -> Pitch
pitch_note_lower :: Pitch -> Pitch
pitch_note_lower (Pitch Note
n Alteration
a Octave
o) =
    if Note
n forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound
    then Note -> Alteration -> Octave -> Pitch
Pitch forall a. Bounded a => a
maxBound Alteration
a (Octave
o forall a. Num a => a -> a -> a
- Octave
1)
    else Note -> Alteration -> Octave -> Pitch
Pitch (forall a. Enum a => a -> a
pred Note
n) Alteration
a Octave
o

-- | Rewrite 'Pitch' to not use @3/4@ tone alterations, ie. re-spell
-- to @1/4@ alteration.
--
-- > let p = Pitch T.A T.ThreeQuarterToneFlat 4
-- > let q = Pitch T.G T.QuarterToneSharp 4
-- > pitch_rewrite_threequarter_alteration p == q
pitch_rewrite_threequarter_alteration :: Pitch -> Pitch
pitch_rewrite_threequarter_alteration :: Pitch -> Pitch
pitch_rewrite_threequarter_alteration (Pitch Note
n Alteration
a Octave
o) =
    case Alteration
a of
      Alteration
T.ThreeQuarterToneFlat -> Pitch -> Pitch
pitch_note_lower (Note -> Alteration -> Octave -> Pitch
Pitch Note
n Alteration
T.QuarterToneSharp Octave
o)
      Alteration
T.ThreeQuarterToneSharp -> Pitch -> Pitch
pitch_note_raise (Note -> Alteration -> Octave -> Pitch
Pitch Note
n Alteration
T.QuarterToneFlat Octave
o)
      Alteration
_ -> Note -> Alteration -> Octave -> Pitch
Pitch Note
n Alteration
a Octave
o

-- | Apply function to 'octave' of 'PitchClass'.
--
-- > pitch_edit_octave (+ 1) (Pitch T.A T.Natural 4) == Pitch T.A T.Natural 5
pitch_edit_octave :: (Octave -> Octave) -> Pitch -> Pitch
pitch_edit_octave :: (Octave -> Octave) -> Pitch -> Pitch
pitch_edit_octave Octave -> Octave
f (Pitch Note
n Alteration
a Octave
o) = Note -> Alteration -> Octave -> Pitch
Pitch Note
n Alteration
a (Octave -> Octave
f Octave
o)

-- * Frequency (CPS)

-- | 'fmidi_to_cps' of 'pitch_to_fmidi', given (k0,f0).
pitch_to_cps_k0 :: Floating n => (n,n) -> Pitch -> n
pitch_to_cps_k0 :: forall n. Floating n => (n, n) -> Pitch -> n
pitch_to_cps_k0 (n, n)
o = forall a. Floating a => (a, a) -> a -> a
T.fmidi_to_cps_k0 (n, n)
o forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Fractional n => Pitch -> n
pitch_to_fmidi

-- | 'fmidi_to_cps' of 'pitch_to_fmidi', given frequency of ISO A4.
pitch_to_cps_f0 :: Floating n => n -> Pitch -> n
pitch_to_cps_f0 :: forall n. Floating n => n -> Pitch -> n
pitch_to_cps_f0 n
f0 = forall n. Floating n => (n, n) -> Pitch -> n
pitch_to_cps_k0 (n
69,n
f0)

-- | 'pitch_to_cps_k0' (60,440).
pitch_to_cps :: Floating n => Pitch -> n
pitch_to_cps :: forall n. Floating n => Pitch -> n
pitch_to_cps = forall n. Floating n => (n, n) -> Pitch -> n
pitch_to_cps_k0 (n
69,n
440)

-- | Frequency (cps = cycles per second) to fractional /midi/ note
-- number, given frequency of ISO A4 (mnn = 69).
cps_to_fmidi_k0 :: Floating a => (a,a) -> a -> a
cps_to_fmidi_k0 :: forall a. Floating a => (a, a) -> a -> a
cps_to_fmidi_k0 (a
k0,a
f0) a
a = (forall a. Floating a => a -> a -> a
logBase a
2 (a
a forall a. Num a => a -> a -> a
* (a
1 forall a. Fractional a => a -> a -> a
/ a
f0)) forall a. Num a => a -> a -> a
* a
12) forall a. Num a => a -> a -> a
+ a
k0

-- | 'cps_to_fmidi_k0' @(69,440)@.
--
-- > cps_to_fmidi 440 == 69
-- > cps_to_fmidi (fmidi_to_cps 60.25) == 60.25
cps_to_fmidi :: Floating a => a -> a
cps_to_fmidi :: forall a. Floating a => a -> a
cps_to_fmidi = forall a. Floating a => (a, a) -> a -> a
cps_to_fmidi_k0 (a
69,a
440)

-- | Frequency (cycles per second) to /midi/ note number,
-- ie. 'round' of 'cps_to_fmidi'.
--
-- > map cps_to_midi [261.6,440] == [60,69]
cps_to_midi :: (Integral i,Floating f,RealFrac f) => f -> i
cps_to_midi :: forall i f. (Integral i, Floating f, RealFrac f) => f -> i
cps_to_midi = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
cps_to_fmidi

-- | 'midi_to_cps_f0' of 'octpc_to_midi', given (k0,f0)
octpc_to_cps_k0 :: (Integral i,Floating n) => (n,n) -> Octave_PitchClass i -> n
octpc_to_cps_k0 :: forall i n.
(Integral i, Floating n) =>
(n, n) -> Octave_PitchClass i -> n
octpc_to_cps_k0 (n, n)
o = forall i f. (Integral i, Floating f) => (f, f) -> i -> f
T.midi_to_cps_k0 (n, n)
o forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Num i => Octave_PitchClass i -> i
octave_pitchclass_to_midi

{- | 'octpc_to_cps_k0' (69,440).

> map (round . octpc_to_cps) [(-1,0),(0,0),(4,9),(9,0)] == [8,16,440,8372]
-}
octpc_to_cps :: (Integral i,Floating n) => Octave_PitchClass i -> n
octpc_to_cps :: forall i n. (Integral i, Floating n) => Octave_PitchClass i -> n
octpc_to_cps = forall i n.
(Integral i, Floating n) =>
(n, n) -> Octave_PitchClass i -> n
octpc_to_cps_k0 (n
69,n
440)

-- | 'midi_to_octpc' of 'cps_to_midi'.
cps_to_octpc :: (Floating f,RealFrac f,Integral i) => f -> Octave_PitchClass i
cps_to_octpc :: forall f i.
(Floating f, RealFrac f, Integral i) =>
f -> Octave_PitchClass i
cps_to_octpc = forall m i. (Integral m, Integral i) => m -> Octave_PitchClass i
midi_to_octave_pitchclass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Real r => r -> Octave
T.real_round_int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
cps_to_fmidi

cps_octave :: (Floating f,RealFrac f) => f -> Octave
cps_octave :: forall f. (Floating f, RealFrac f) => f -> Octave
cps_octave = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall f i.
(Floating f, RealFrac f, Integral i) =>
f -> Octave_PitchClass i
cps_to_octpc

-- * MIDI detune (cents)

-- | Is cents in (-50,+50].
--
-- > map cents_is_normal [-250,-75,75,250] == replicate 4 False
cents_is_normal :: (Num c, Ord c) => c -> Bool
cents_is_normal :: forall c. (Num c, Ord c) => c -> Bool
cents_is_normal c
c = c
c forall a. Ord a => a -> a -> Bool
> (-c
50) Bool -> Bool -> Bool
&& c
c forall a. Ord a => a -> a -> Bool
<= c
50

-- | 'cents_is_normal' of 'snd'.
midi_detune_is_normal :: (Num c, Ord c) => (x,c) -> Bool
midi_detune_is_normal :: forall c x. (Num c, Ord c) => (x, c) -> Bool
midi_detune_is_normal = forall c. (Num c, Ord c) => c -> Bool
cents_is_normal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

-- | In normal form the detune is in the range (-50,+50] instead of [0,100) or wider.
--
-- > map midi_detune_normalise [(60,-250),(60,-75),(60,75),(60,250)]
midi_detune_normalise :: (Num m,Ord c,Num c) => (m,c) -> (m,c)
midi_detune_normalise :: forall m c. (Num m, Ord c, Num c) => (m, c) -> (m, c)
midi_detune_normalise =
  let recur :: (a, b) -> (a, b)
recur (a
m,b
c) =
        if b
c forall a. Ord a => a -> a -> Bool
> b
50
        then (a, b) -> (a, b)
recur (a
m forall a. Num a => a -> a -> a
+ a
1,b
c forall a. Num a => a -> a -> a
- b
100)
        else if b
c forall a. Ord a => a -> a -> Bool
> (-b
50)
             then (a
m,b
c)
             else (a, b) -> (a, b)
recur (a
m forall a. Num a => a -> a -> a
- a
1,b
c forall a. Num a => a -> a -> a
+ b
100)
  in forall {b} {a}. (Ord b, Num b, Num a) => (a, b) -> (a, b)
recur

-- | In normal-positive form the detune is in the range (0,+100].
--
-- > map midi_detune_normalise_positive [(60,-250),(60,-75),(60,75),(60,250)]
midi_detune_normalise_positive :: (Num m,Ord m,Ord c,Num c) => (m,c) -> (m,c)
midi_detune_normalise_positive :: forall m c. (Num m, Ord m, Ord c, Num c) => (m, c) -> (m, c)
midi_detune_normalise_positive =
  let recur :: (a, b) -> (a, b)
recur (a
m,b
c) =
        if b
c forall a. Ord a => a -> a -> Bool
< b
0
        then (a, b) -> (a, b)
recur (a
m forall a. Num a => a -> a -> a
- a
1,b
c forall a. Num a => a -> a -> a
+ b
100)
        else if b
c forall a. Ord a => a -> a -> Bool
> b
100
        then (a, b) -> (a, b)
recur (a
m forall a. Num a => a -> a -> a
+ a
1,b
c forall a. Num a => a -> a -> a
- b
100)
        else (a
m,b
c)
  in forall {b} {a}. (Ord b, Num b, Num a) => (a, b) -> (a, b)
recur

-- | Inverse of 'cps_to_midi_detune', given frequency of ISO @A4@.
midi_detune_to_cps_f0 :: (Integral m,Real c) => Double -> (m,c) -> Double
midi_detune_to_cps_f0 :: forall m c. (Integral m, Real c) => Double -> (m, c) -> Double
midi_detune_to_cps_f0 Double
f0 (m
m,c
c) = forall a. Floating a => a -> a -> a
T.fmidi_to_cps_f0 Double
f0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral m
m forall a. Num a => a -> a -> a
+ (forall a b. (Real a, Fractional b) => a -> b
realToFrac c
c forall a. Fractional a => a -> a -> a
/ Double
100))

-- | Inverse of 'cps_to_midi_detune'.
--
-- > map midi_detune_to_cps [(69,0),(68,100)] == [440,440]
midi_detune_to_cps :: (Integral m,Real c) => (m,c) -> Double
midi_detune_to_cps :: forall m c. (Integral m, Real c) => (m, c) -> Double
midi_detune_to_cps = forall m c. (Integral m, Real c) => Double -> (m, c) -> Double
midi_detune_to_cps_f0 Double
440

-- | 'Midi_Detune' to fractional midi note number.
--
-- > midi_detune_to_fmidi (60,50.0) == 60.50
midi_detune_to_fmidi :: (Integral m,Real c) => (m,c) -> Double
midi_detune_to_fmidi :: forall m c. (Integral m, Real c) => (m, c) -> Double
midi_detune_to_fmidi (m
mnn,c
c) = forall a b. (Integral a, Num b) => a -> b
fromIntegral m
mnn forall a. Num a => a -> a -> a
+ (forall a b. (Real a, Fractional b) => a -> b
realToFrac c
c forall a. Fractional a => a -> a -> a
/ Double
100)

-- | 'Midi_Detune' to 'Pitch', detune must be precisely at a notateable Pitch.
--
-- > let p = Pitch {note = T.C, alteration = T.QuarterToneSharp, octave = 4}
-- > midi_detune_to_pitch T.pc_spell_ks (midi_detune_nearest_24et (60,35)) == p
midi_detune_to_pitch :: (Integral m,Real c) => Spelling Int -> (m,c) -> Pitch
midi_detune_to_pitch :: forall m c.
(Integral m, Real c) =>
Spelling Octave -> (m, c) -> Pitch
midi_detune_to_pitch Spelling Octave
sp = forall n. (Show n, RealFrac n) => Spelling Octave -> n -> Pitch
fmidi_to_pitch_err Spelling Octave
sp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
cps_to_fmidi forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m c. (Integral m, Real c) => (m, c) -> Double
midi_detune_to_cps

-- | Midi note number with real-valued cents detune.
type Midi_Detune = (Midi,Double)

-- | Fractional midi note number to 'Midi_Detune'.
--
-- > fmidi_to_midi_detune 60.50 == (60,50.0)
fmidi_to_midi_detune :: Double -> Midi_Detune
fmidi_to_midi_detune :: Double -> (Octave, Double)
fmidi_to_midi_detune Double
mnn =
    let (Octave
n,Double
c) = forall i t. (Integral i, RealFrac t) => t -> (i, t)
T.integral_and_fractional_parts Double
mnn
    in (Octave
n,Double
c forall a. Num a => a -> a -> a
* Double
100)

-- | Frequency (in hertz) to 'Midi_Detune'.
--
-- > map (fmap round . cps_to_midi_detune) [440.00,508.35] == [(69,0),(71,50)]
cps_to_midi_detune :: Double -> Midi_Detune
cps_to_midi_detune :: Double -> (Octave, Double)
cps_to_midi_detune = Double -> (Octave, Double)
fmidi_to_midi_detune forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Floating a => a -> a
cps_to_fmidi

-- | Round /detune/ value to nearest multiple of @50@, normalised.
--
-- > map midi_detune_nearest_24et [(59,70),(59,80)] == [(59,50),(60,00)]
midi_detune_nearest_24et :: Midi_Detune -> Midi_Detune
midi_detune_nearest_24et :: (Octave, Double) -> (Octave, Double)
midi_detune_nearest_24et (Octave
m,Double
dt) = forall m c. (Num m, Ord c, Num c) => (m, c) -> (m, c)
midi_detune_normalise (Octave
m,forall f. RealFrac f => f -> f -> f
T.round_to Double
50 Double
dt)

-- * MIDI cents

-- | Midi note number with integral cents detune.
type Midi_Cents = (Midi,Int)

midi_detune_to_midi_cents :: Midi_Detune -> Midi_Cents
midi_detune_to_midi_cents :: (Octave, Double) -> OctPc
midi_detune_to_midi_cents (Octave
m,Double
c) = (Octave
m,forall a b. (RealFrac a, Integral b) => a -> b
round Double
c)

-- | Printed as /fmidi/ value with cents to two places.  Must be normal.
--
-- > map midi_cents_pp [(60,0),(60,25)] == ["60.00","60.25"]
midi_cents_pp :: Midi_Cents -> String
midi_cents_pp :: OctPc -> String
midi_cents_pp (Octave
m,Octave
c) = if forall c. (Num c, Ord c) => c -> Bool
cents_is_normal Octave
c then forall r. PrintfType r => String -> r
printf String
"%d.%02d" Octave
m Octave
c else forall a. HasCallStack => String -> a
error String
"midi_cents_pp"

-- * 24ET

{- | The 24ET pitch-class universe, with /sharp/ spellings, in octave '4'.

> length pc24et_univ == 24

> let r = "C C𝄲 C♯ C𝄰 D D𝄲 D♯ D𝄰 E E𝄲 F F𝄲 F♯ F𝄰 G G𝄲 G♯ G𝄰 A A𝄲 A♯ A𝄰 B B𝄲"
> unwords (map pitch_class_pp pc24et_univ) == r

-}
pc24et_univ :: [Pitch]
pc24et_univ :: [Pitch]
pc24et_univ =
    let a :: [Alteration]
a = [Alteration
T.Natural,Alteration
T.QuarterToneSharp,Alteration
T.Sharp,Alteration
T.ThreeQuarterToneSharp]
        f :: (Note, Octave) -> [Pitch]
f (Note
n,Octave
k) = forall a b. (a -> b) -> [a] -> [b]
map (\Octave
i -> Note -> Alteration -> Octave -> Pitch
Pitch Note
n ([Alteration]
a forall a. [a] -> Octave -> a
!! Octave
i) Octave
4) [Octave
0 .. Octave
k forall a. Num a => a -> a -> a
- Octave
1]
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Note, Octave) -> [Pitch]
f (forall a b. [a] -> [b] -> [(a, b)]
zip [Note]
T.note_seq [Octave
4,Octave
4,Octave
2,Octave
4,Octave
4,Octave
4,Octave
2])

-- | 'genericIndex' into 'pc24et_univ'.
--
-- > pitch_class_pp (pc24et_to_pitch 13) == "F𝄰"
pc24et_to_pitch :: Integral i => i -> Pitch
pc24et_to_pitch :: forall i. Integral i => i -> Pitch
pc24et_to_pitch = forall i a. Integral i => [a] -> i -> a
genericIndex [Pitch]
pc24et_univ

-- * Pitch, rational alteration.

-- | Generalised pitch, given by a generalised alteration.
data Pitch_R = Pitch_R T.Note T.Alteration_R Octave
               deriving (Pitch_R -> Pitch_R -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pitch_R -> Pitch_R -> Bool
$c/= :: Pitch_R -> Pitch_R -> Bool
== :: Pitch_R -> Pitch_R -> Bool
$c== :: Pitch_R -> Pitch_R -> Bool
Eq,Octave -> Pitch_R -> ShowS
[Pitch_R] -> ShowS
Pitch_R -> String
forall a.
(Octave -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pitch_R] -> ShowS
$cshowList :: [Pitch_R] -> ShowS
show :: Pitch_R -> String
$cshow :: Pitch_R -> String
showsPrec :: Octave -> Pitch_R -> ShowS
$cshowsPrec :: Octave -> Pitch_R -> ShowS
Show)

-- | Pretty printer for 'Pitch_R'.
pitch_r_pp :: Pitch_R -> String
pitch_r_pp :: Pitch_R -> String
pitch_r_pp (Pitch_R Note
n (Ratio Integer
_,String
a) Octave
o) = forall a. Show a => a -> String
show Note
n forall a. [a] -> [a] -> [a]
++ String
a forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Octave
o

-- | 'Pitch_R' printed without octave.
pitch_r_class_pp :: Pitch_R -> String
pitch_r_class_pp :: Pitch_R -> String
pitch_r_class_pp = forall a. (a -> Bool) -> [a] -> [a]
T.dropWhileRight Char -> Bool
isDigit forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch_R -> String
pitch_r_pp

-- * Parsers

-- | Parser for single digit ISO octave (C4 = middle-C)
p_octave_iso :: T.P Octave
p_octave_iso :: P Octave
p_octave_iso = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Octave
digitToInt forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit

-- | Parser for single digit ISO octave with default value in case of no parse.
p_octave_iso_opt :: Octave -> T.P Octave
p_octave_iso_opt :: Octave -> P Octave
p_octave_iso_opt Octave
def_o = do
  Maybe Octave
o <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe P Octave
p_octave_iso
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a -> a
fromMaybe Octave
def_o Maybe Octave
o)

-- | Parser for ISO pitch notation.
p_iso_pitch_strict :: T.P Pitch
p_iso_pitch_strict :: P Pitch
p_iso_pitch_strict = do
  Note
n <- P Note
T.p_note_t
  Alteration
a <- Bool -> P Alteration
T.p_alteration_t_iso Bool
True
  Octave
o <- P Octave
p_octave_iso
  forall (m :: * -> *) a. Monad m => a -> m a
return (Note -> Alteration -> Octave -> Pitch
Pitch  Note
n Alteration
a Octave
o)

-- | Parser for extended form of ISO pitch notation.
p_iso_pitch_oct :: Octave -> T.P Pitch
p_iso_pitch_oct :: Octave -> P Pitch
p_iso_pitch_oct Octave
def_o = do
  Note
n <- P Note
T.p_note_t_ci -- ISO is requires upper case note names
  Alteration
a <- Bool -> P Alteration
T.p_alteration_t_iso Bool
False -- ISO does not allow ##
  Octave
o <- Octave -> P Octave
p_octave_iso_opt Octave
def_o -- ISO requires octave
  forall (m :: * -> *) a. Monad m => a -> m a
return (Note -> Alteration -> Octave -> Pitch
Pitch  Note
n Alteration
a Octave
o)

-- | Parse possible octave from single integer.
--
-- > map (parse_octave 2) ["","4","x","11"] == [2,4,2,1]x
parse_octave :: Octave -> String -> Octave
parse_octave :: Octave -> String -> Octave
parse_octave Octave
def_o = forall c. P c -> String -> c
T.run_parser_error (Octave -> P Octave
p_octave_iso_opt Octave
def_o)

-- | Generalisation of ISO pitch representation.  Allows octave
-- to be elided, pitch names to be lower case, and double sharps
-- written as @##@.
--
-- See <http://www.musiccog.ohio-state.edu/Humdrum/guide04.html>
--
-- > let r = [Pitch T.C T.Natural 4,Pitch T.A T.Flat 5,Pitch T.F T.DoubleSharp 6]
-- > mapMaybe (parse_iso_pitch_oct 4) ["C","Ab5","f##6",""] == r
parse_iso_pitch_oct :: Octave -> String -> Maybe Pitch
parse_iso_pitch_oct :: Octave -> String -> Maybe Pitch
parse_iso_pitch_oct Octave
def_o = forall t. P t -> String -> Maybe t
T.run_parser_maybe (Octave -> P Pitch
p_iso_pitch_oct Octave
def_o)

-- | Variant of 'parse_iso_pitch_oct' requiring octave.
parse_iso_pitch :: String -> Maybe Pitch
parse_iso_pitch :: String -> Maybe Pitch
parse_iso_pitch = Octave -> String -> Maybe Pitch
parse_iso_pitch_oct (forall a. HasCallStack => String -> a
error String
"parse_iso_pitch: no octave")

-- | 'error' variant.
parse_iso_pitch_err :: String -> Pitch
parse_iso_pitch_err :: String -> Pitch
parse_iso_pitch_err = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"parse_iso_pitch") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Pitch
parse_iso_pitch

-- * Pretty printers

-- | Pretty printer for 'Pitch' (unicode, see 'alteration_symbol').
-- Option selects if 'Natural's are printed.
--
-- > pitch_pp_opt (True,True) (Pitch T.E T.Natural 4) == "E♮4"
pitch_pp_opt :: (Bool,Bool) -> Pitch -> String
pitch_pp_opt :: (Bool, Bool) -> Pitch -> String
pitch_pp_opt (Bool
show_nat,Bool
show_oct) (Pitch Note
n Alteration
a Octave
o) =
    let a' :: String
a' = if Alteration
a forall a. Eq a => a -> a -> Bool
== Alteration
T.Natural Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
show_nat then String
"" else [Alteration -> Char
T.alteration_symbol Alteration
a]
        rem_oct_f :: Char -> Bool
rem_oct_f Char
c = Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' -- negative octave values...
        rem_oct :: ShowS
rem_oct = if Bool
show_oct then forall a. a -> a
id else forall a. (a -> Bool) -> [a] -> [a]
T.dropWhileRight Char -> Bool
rem_oct_f
    in ShowS
rem_oct (forall a. Show a => a -> String
show Note
n forall a. [a] -> [a] -> [a]
++ String
a' forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Octave
o)

-- | 'pitch_pp_opt' with default options, ie. (False,True).
--
-- > pitch_pp (Pitch T.E T.Natural 4) == "E4"
-- > pitch_pp (Pitch T.E T.Flat 4) == "E♭4"
-- > pitch_pp (Pitch T.F T.QuarterToneSharp 3) == "F𝄲3"
pitch_pp :: Pitch -> String
pitch_pp :: Pitch -> String
pitch_pp = (Bool, Bool) -> Pitch -> String
pitch_pp_opt (Bool
False,Bool
True)

-- | 'pitch_pp_opt' with options (False,False).
--
-- > pitch_class_pp (Pitch T.C T.ThreeQuarterToneSharp 0) == "C𝄰"
pitch_class_pp :: Pitch -> String
pitch_class_pp :: Pitch -> String
pitch_class_pp = (Bool, Bool) -> Pitch -> String
pitch_pp_opt (Bool
False,Bool
False)

-- | Sequential list of /n/ pitch class names starting from /k/.
--
-- > import Music.Theory.Pitch.Spelling.Table
-- > unwords (pitch_class_names_12et pc_spell_ks 0 12) == "C C♯ D E♭ E F F♯ G A♭ A B♭ B"
-- > pitch_class_names_12et pc_spell_ks 11 2 == ["B","C"]
pitch_class_names_12et :: Integral n => Spelling n -> n -> n -> [String]
pitch_class_names_12et :: forall n. Integral n => Spelling n -> n -> n -> [String]
pitch_class_names_12et Spelling n
sp n
k n
n =
    let f :: n -> String
f = Pitch -> String
pitch_class_pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i k. (Integral i, Integral k) => Spelling k -> i -> Pitch
midi_to_pitch Spelling n
sp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => i -> Octave
T.from_integral_to_int
    in forall a b. (a -> b) -> [a] -> [b]
map n -> String
f [n
60 forall a. Num a => a -> a -> a
+ n
k .. n
60 forall a. Num a => a -> a -> a
+ n
k forall a. Num a => a -> a -> a
+ n
n forall a. Num a => a -> a -> a
- n
1]

-- | Pretty printer for 'Pitch' (ISO, ASCII, see 'alteration_iso').
--
-- > pitch_pp_iso (Pitch E Flat 4) == "Eb4"
-- > pitch_pp_iso (Pitch F DoubleSharp 3) == "Fx3"
-- > pitch_pp_iso (Pitch C ThreeQuarterToneSharp 4) -- error
pitch_pp_iso :: Pitch -> String
pitch_pp_iso :: Pitch -> String
pitch_pp_iso (Pitch Note
n Alteration
a Octave
o) = forall a. Show a => a -> String
show Note
n forall a. [a] -> [a] -> [a]
++ Alteration -> String
T.alteration_iso Alteration
a forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Octave
o

-- | Lilypond octave syntax.
ly_octave_tbl :: [(Octave, String)]
ly_octave_tbl :: [(Octave, String)]
ly_octave_tbl =
  [(-Octave
1,String
",,,,")
  ,( Octave
0,String
",,,")
  ,( Octave
1,String
",,")
  ,( Octave
2,String
",")
  ,( Octave
3,String
"")
  ,( Octave
4,String
"'")
  ,( Octave
5,String
"''")
  ,( Octave
6,String
"'''")
  ,( Octave
7,String
"''''")
  ,( Octave
8,String
"'''''")]

-- | Lookup 'ly_octave_tbl'.
octave_pp_ly :: Octave -> String
octave_pp_ly :: Octave -> String
octave_pp_ly Octave
o = forall k v. Eq k => k -> [(k, v)] -> v
T.lookup_err Octave
o [(Octave, String)]
ly_octave_tbl

-- | Parse lilypond octave indicator.
octave_parse_ly :: String -> Maybe Octave
octave_parse_ly :: String -> Maybe Octave
octave_parse_ly String
s = forall v k. Eq v => v -> [(k, v)] -> Maybe k
T.reverse_lookup String
s [(Octave, String)]
ly_octave_tbl

-- | Pretty printer for 'Pitch' (ASCII, see 'alteration_tonh').
--
-- > pitch_pp_hly (Pitch E Flat 4) == "ees4"
-- > pitch_pp_hly (Pitch F QuarterToneSharp 3) == "fih3"
-- > pitch_pp_hly (Pitch B Natural 6) == "b6"
pitch_pp_hly :: Pitch -> String
pitch_pp_hly :: Pitch -> String
pitch_pp_hly (Pitch Note
n Alteration
a Octave
o) =
    let n' :: String
n' = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (forall a. Show a => a -> String
show Note
n)
    in String
n' forall a. [a] -> [a] -> [a]
++ Alteration -> String
T.alteration_tonh Alteration
a forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Octave
o

-- | Pretty printer for 'Pitch' (Tonhöhe, see 'alteration_tonh').
--
-- > pitch_pp_tonh (Pitch E Flat 4) == "Es4"
-- > pitch_pp_tonh (Pitch F QuarterToneSharp 3) == "Fih3"
-- > pitch_pp_tonh (Pitch B Natural 6) == "H6"
pitch_pp_tonh :: Pitch -> String
pitch_pp_tonh :: Pitch -> String
pitch_pp_tonh (Pitch Note
n Alteration
a Octave
o) =
    let o' :: String
o' = forall a. Show a => a -> String
show Octave
o
    in case (Note
n,Alteration
a) of
         (Note
T.B,Alteration
T.Natural) -> String
"H" forall a. [a] -> [a] -> [a]
++ String
o'
         (Note
T.B,Alteration
T.Flat) -> String
"B" forall a. [a] -> [a] -> [a]
++ String
o'
         (Note
T.B,Alteration
T.DoubleFlat) -> String
"Heses" forall a. [a] -> [a] -> [a]
++ String
o'
         (Note
T.A,Alteration
T.Flat) -> String
"As" forall a. [a] -> [a] -> [a]
++ String
o'
         (Note
T.E,Alteration
T.Flat) -> String
"Es" forall a. [a] -> [a] -> [a]
++ String
o'
         (Note, Alteration)
_ -> forall a. Show a => a -> String
show Note
n forall a. [a] -> [a] -> [a]
++ Alteration -> String
T.alteration_tonh Alteration
a forall a. [a] -> [a] -> [a]
++ String
o'

-- * Parsers

p_octave_ly :: T.P Octave
p_octave_ly :: P Octave
p_octave_ly =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"p_octave_ly") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Octave
octave_parse_ly)
    (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
",'"))

p_pitch_ly :: T.P Pitch
p_pitch_ly :: P Pitch
p_pitch_ly = do
  (Note
n,Maybe Alteration
a) <- P (Note, Maybe Alteration)
T.p_note_alteration_ly
  Maybe Octave
o <- forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe P Octave
p_octave_ly
  forall (m :: * -> *) a. Monad m => a -> m a
return (Note -> Alteration -> Octave -> Pitch
Pitch Note
n (forall a. a -> Maybe a -> a
fromMaybe Alteration
T.Natural Maybe Alteration
a) (forall a. a -> Maybe a -> a
fromMaybe Octave
3 Maybe Octave
o))

-- | Run 'p_pitch_ly'.
--
-- > map (pitch_pp . pitch_parse_ly_err) ["c","d'","ees,","fisis''"] == ["C3","D4","E♭2","F𝄪5"]
pitch_parse_ly_err :: String -> Pitch
pitch_parse_ly_err :: String -> Pitch
pitch_parse_ly_err = forall c. P c -> String -> c
T.run_parser_error P Pitch
p_pitch_ly

-- | Parser for hly notation.
p_pitch_hly :: T.P Pitch
p_pitch_hly :: P Pitch
p_pitch_hly = do
  (Note
n,Maybe Alteration
a) <- P (Note, Maybe Alteration)
T.p_note_alteration_ly
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Note -> Alteration -> Octave -> Pitch
Pitch Note
n (forall a. a -> Maybe a -> a
fromMaybe Alteration
T.Natural Maybe Alteration
a)) P Octave
p_octave_iso

-- | Run 'p_pitch_hly'.
--
-- > map (pitch_pp . pitch_parse_hly) ["ees4","fih3","b6"] == ["E♭4","F𝄲3","B6"]
pitch_parse_hly :: String -> Pitch
pitch_parse_hly :: String -> Pitch
pitch_parse_hly = forall c. P c -> String -> c
T.run_parser_error P Pitch
p_pitch_hly