module Csound.Tuning(
    -- * Temperament
    Temp(..), genTemp, genTempRatio,
    tempC, tempRatioC, stdTemp, stdTempRatio, barTemp, barTempRatio, concertA, ratioConcertA,

    -- * Specific temperaments
    equal1, just1, meantone, pythagor,
    werckmeister, young1, young2, young3,

    -- ** In cents
    equalCents1, justCents1, meantoneCents, pythagorCents,
    werckmeisterCents, youngCents1, youngCents2, youngCents3,

    -- * List of temperaments
    TempList(..), tempList, fromTempList, fromTempListD,

    -- * Utility functions
    cent2ratio, ratio2cent
) where

import Data.Default

import Csound.Types
import Csound.Tab

-- | Creates a temperament. Arguments are
--
-- > genTemp interval baseHz baseMidiPitch cents
--
-- For example:
--
-- > genTemp 2 261.63 60 [0, 100, 200 .. more cents .. , 1200]
--
-- Cent list should include the first note from the next octave(interval of temperament repetition).
genTemp :: Double -> Double -> Double -> [Double] -> Temp
genTemp :: Double -> Double -> Double -> [Double] -> Temp
genTemp Double
tempInterval Double
tempBase Double
tempKey [Double]
tempCents = Double -> Double -> Double -> [Double] -> Temp
genTempRatio Double
tempInterval Double
tempBase Double
tempKey ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Double
forall a. Floating a => a -> a
cent2ratio [Double]
tempCents)

-- | Creates a temperament. Arguments are
--
-- > genTempCent interval baseHz baseMidiPitch ratios
--
-- For example:
--
-- > genTempRatio 2 261.63 60 [1, .. more ratios .. , 2]
--
-- Cent list should include the first note from the next octave(interval of temperament repetition).
genTempRatio :: Double -> Double -> Double -> [Double] -> Temp
genTempRatio :: Double -> Double -> Double -> [Double] -> Temp
genTempRatio Double
tempInterval Double
tempBase Double
tempKey [Double]
tempRatios = Tab -> Temp
Temp (Tab -> Temp) -> Tab -> Temp
forall a b. (a -> b) -> a -> b
$ [Double] -> Tab
doubles [Double]
vals
    where vals :: [Double]
vals = [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
tempRatios) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Double
tempInterval, Double
tempBase, Double
tempKey] [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ [Double]
tempRatios

-- | Temperament with base note at note C (261.63 Hz) and an octave as interval (2).
-- The argument is the list of ratios.
tempRatioC :: [Double] -> Temp
tempRatioC :: [Double] -> Temp
tempRatioC = Double -> Double -> Double -> [Double] -> Temp
genTempRatio Double
2 Double
261.63 Double
60

-- | Temperament with base note at note C (261.63 Hz) and an octave as interval (2).
-- The argument is the list of cents.
tempC :: [Double] -> Temp
tempC :: [Double] -> Temp
tempC = Double -> Double -> Double -> [Double] -> Temp
genTemp Double
2 Double
261.63 Double
60

-- | Temperament with 9th note tuned to 440 Hz (Concert A).
-- The argument is the list of ratios.
stdTempRatio :: [Double] -> Temp
stdTempRatio :: [Double] -> Temp
stdTempRatio  = Double -> [Double] -> Temp
ratioConcertA Double
440

-- | Temperament with 9th note tuned to 440 Hz (Concert A).
-- The argument is the list of cents.
stdTemp :: [Double] -> Temp
stdTemp :: [Double] -> Temp
stdTemp = Double -> [Double] -> Temp
concertA Double
440

-- | Baroque Temperament with 9th note tuned to 415 Hz (Concert A).
-- The argument is the list of ratios.
barTempRatio :: [Double] -> Temp
barTempRatio :: [Double] -> Temp
barTempRatio  = Double -> [Double] -> Temp
ratioConcertA Double
415

-- | Baroque Temperament with 9th note tuned to 415 Hz (Concert A).
-- The argument is the list of cents.
barTemp :: [Double] -> Temp
barTemp :: [Double] -> Temp
barTemp = Double -> [Double] -> Temp
concertA Double
415

-- | Temperament with 9th note tuned to 440 Hz (Concert A).
-- The argument is the list of ratios.
ratioConcertA :: Double -> [Double] -> Temp
ratioConcertA :: Double -> [Double] -> Temp
ratioConcertA Double
hz [Double]
ratios = Double -> Double -> Double -> [Double] -> Temp
genTempRatio Double
2 (Double
hz Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ ([Double]
ratios [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
9)) Double
60 [Double]
ratios

-- | Temperament with 9th note tuned to 440 Hz (Concert A).
-- The argument is the list of cents.
concertA :: Double -> [Double] -> Temp
concertA :: Double -> [Double] -> Temp
concertA Double
hz [Double]
cents = Double -> [Double] -> Temp
ratioConcertA Double
hz ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Double
forall a. Floating a => a -> a
cent2ratio [Double]
cents)


-- | Data structure for musical temperament.
-- The value can be created with constructors @genTemp@ and @genTempCent@.
-- It can be passed as an argument to the instrument (it can be a part of the note).
newtype Temp = Temp { Temp -> Tab
unTemp :: Tab }

instance Default Temp where
    def :: Temp
def = Temp
equal1

-- | List of temperaments (or more precisely f-table of temperaments).
-- It can be passed as an argument to the instrument (it can be a part of the note).
newtype TempList = TempList { TempList -> TabList
unTempList :: TabList }

instance Tuple Temp where
    tupleMethods :: TupleMethods Temp
tupleMethods = (Tab -> Temp) -> (Temp -> Tab) -> TupleMethods Temp
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods Tab -> Temp
Temp Temp -> Tab
unTemp

instance Arg Temp where

instance Tuple TempList where
    tupleMethods :: TupleMethods TempList
tupleMethods = (TabList -> TempList)
-> (TempList -> TabList) -> TupleMethods TempList
forall a b. Tuple a => (a -> b) -> (b -> a) -> TupleMethods b
makeTupleMethods TabList -> TempList
TempList TempList -> TabList
unTempList

instance Arg TempList where

-- | Creates a list of temperaments.
tempList :: [Temp] -> TempList
tempList :: [Temp] -> TempList
tempList [Temp]
xs = TabList -> TempList
TempList (TabList -> TempList) -> TabList -> TempList
forall a b. (a -> b) -> a -> b
$ [Tab] -> TabList
tabList ([Tab] -> TabList) -> [Tab] -> TabList
forall a b. (a -> b) -> a -> b
$ (Temp -> Tab) -> [Temp] -> [Tab]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Temp -> Tab
unTemp [Temp]
xs

-- | Selects one of the temperaments by index.
fromTempList :: TempList -> Sig -> Temp
fromTempList :: TempList -> Sig -> Temp
fromTempList (TempList TabList
tab) Sig
asig = Tab -> Temp
Temp (Tab -> Temp) -> Tab -> Temp
forall a b. (a -> b) -> a -> b
$ TabList -> Sig -> Tab
fromTabList TabList
tab Sig
asig

-- | Selects one of the temperaments by index. Works at the time of instrument initialization (remains constant).
fromTempListD :: TempList -> D -> Temp
fromTempListD :: TempList -> D -> Temp
fromTempListD (TempList TabList
tab) D
a = Tab -> Temp
Temp (Tab -> Temp) -> Tab -> Temp
forall a b. (a -> b) -> a -> b
$ TabList -> D -> Tab
fromTabListD TabList
tab D
a

-- | Converts cents to ratios.
cent2ratio :: Floating a => a -> a
cent2ratio :: forall a. Floating a => a -> a
cent2ratio a
x = a
2 a -> a -> a
forall a. Floating a => a -> a -> a
** (a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1200)

-- | Converts ratios to cents.
ratio2cent :: Floating a => a -> a
ratio2cent :: forall a. Floating a => a -> a
ratio2cent a
x = a
1200 a -> a -> a
forall a. Num a => a -> a -> a
* a -> a -> a
forall a. Floating a => a -> a -> a
logBase a
2 a
x

equalCents1, justCents1, meantoneCents, pythagorCents, werckmeisterCents,
  youngCents1, youngCents2, youngCents3 :: [Double]

equalCents1 :: [Double]
equalCents1         = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) [Double
0 .. Double
12]
justCents1 :: [Double]
justCents1          = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Double
forall a. Floating a => a -> a
ratio2cent [Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1, Double
16Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
15,   Double
9Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
8, Double
6Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
5, Double
5Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
4, Double
4Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
3, Double
45Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
32,   Double
3Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2, Double
8Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
5, Double
5Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
3, Double
9Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
5, Double
15Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
8,  Double
2Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1]
meantoneCents :: [Double]
meantoneCents       = [Double
0,    Double
76.0,    Double
193.2,   Double
310.3,   Double
386.3,   Double
503.4,   Double
579.5,   Double
696.8,   Double
772.6,   Double
889.7,   Double
1006.8,  Double
1082.9,  Double
1200]
pythagorCents :: [Double]
pythagorCents       = [Double
0,   Double
113.7,   Double
203.9,   Double
294.1,   Double
407.8,   Double
498, Double
611.7,   Double
702, Double
792.2,   Double
905.9,   Double
996.1,   Double
1109.8, Double
1200]
werckmeisterCents :: [Double]
werckmeisterCents   = [Double
0,  Double
90.225,  Double
192.18,  Double
294.135, Double
390.225, Double
498.045, Double
588.27,  Double
696.09,  Double
792.18,  Double
888.27,  Double
996.09,  Double
1092.18, Double
1200]

youngCents1 :: [Double]
youngCents1         = [Double
0,    Double
93.9,    Double
195.8,   Double
297.8,   Double
391.7,   Double
499.9,   Double
591.9,   Double
697.9,   Double
795.8,   Double
893.8,   Double
999.8,   Double
1091.8,  Double
1200]
youngCents2 :: [Double]
youngCents2         = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) [Double]
equalCents1 [Double
0, Double
0.1, Double
2.1, Double
4, -Double
2.1, Double
6.1, -Double
1.8, Double
4.2, Double
2.1, Double
0, Double
6, -Double
2, Double
0]
youngCents3 :: [Double]
youngCents3         = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) [Double]
equalCents1 [Double
0, -Double
3.9, Double
2, Double
0, -Double
2, Double
3.9, -Double
5.9, Double
3.9, -Double
2, Double
0, Double
2, -Double
3.9, Double
0]

toTemp :: [Double] -> Temp
toTemp :: [Double] -> Temp
toTemp = [Double] -> Temp
tempC

-- | Equal temperament
equal1 :: Temp
equal1 :: Temp
equal1          = [Double] -> Temp
toTemp [Double]
equalCents1

-- | Just intonation
just1 :: Temp
just1 :: Temp
just1           = [Double] -> Temp
toTemp [Double]
justCents1

-- | Meantone temperament
meantone :: Temp
meantone :: Temp
meantone       = [Double] -> Temp
toTemp [Double]
meantoneCents

-- | Pythagorean tuning
pythagor :: Temp
pythagor :: Temp
pythagor       = [Double] -> Temp
toTemp [Double]
pythagorCents

-- | Werckmeister III temperament. Probably it was temperament of the Bach musical era.
werckmeister :: Temp
werckmeister :: Temp
werckmeister   = [Double] -> Temp
toTemp [Double]
werckmeisterCents

-- | Tomas Young temperament
young1 :: Temp
young1 :: Temp
young1          = [Double] -> Temp
toTemp [Double]
youngCents1

-- | Tomas Young temperament 1 (aligned with ET by C and A)
young2 :: Temp
young2 :: Temp
young2         = [Double] -> Temp
toTemp [Double]
youngCents2

-- | Tomas Young temperament 2 (aligned with ET by C and A)
young3 :: Temp
young3 :: Temp
young3         = [Double] -> Temp
toTemp [Double]
youngCents3