module Csound.Tuning(
Temp(..), genTemp, genTempRatio,
tempC, tempRatioC, stdTemp, stdTempRatio, barTemp, barTempRatio, concertA, ratioConcertA,
equal1, just1, meantone, pythagor,
werckmeister, young1, young2, young3,
equalCents1, justCents1, meantoneCents, pythagorCents,
werckmeisterCents, youngCents1, youngCents2, youngCents3,
TempList(..), tempList, fromTempList, fromTempListD,
cent2ratio, ratio2cent
) where
import Data.Default
import Csound.Types
import Csound.Tab
import Csound.Typed.Opcode
genTemp :: Double -> Double -> Double -> [Double] -> Temp
genTemp tempInterval tempBase tempKey tempCents = genTempRatio tempInterval tempBase tempKey (fmap cent2ratio tempCents)
genTempRatio :: Double -> Double -> Double -> [Double] -> Temp
genTempRatio tempInterval tempBase tempKey tempRatios = Temp $ doubles vals
where vals = [fromIntegral $ (length tempRatios) - 1, tempInterval, tempBase, tempKey] ++ tempRatios
tempRatioC :: [Double] -> Temp
tempRatioC = genTempRatio 2 261.63 60
tempC :: [Double] -> Temp
tempC = genTemp 2 261.63 60
stdTempRatio :: [Double] -> Temp
stdTempRatio = ratioConcertA 440
stdTemp :: [Double] -> Temp
stdTemp = concertA 440
barTempRatio :: [Double] -> Temp
barTempRatio = ratioConcertA 415
barTemp :: [Double] -> Temp
barTemp = concertA 415
ratioConcertA :: Double -> [Double] -> Temp
ratioConcertA hz ratios = genTempRatio 2 (hz / (ratios !! 9)) 60 ratios
concertA :: Double -> [Double] -> Temp
concertA hz cents = ratioConcertA hz (fmap cent2ratio cents)
newtype Temp = Temp { unTemp :: Tab }
instance Default Temp where
def = equal1
newtype TempList = TempList { unTempList :: TabList }
instance Tuple Temp where
tupleMethods = makeTupleMethods Temp unTemp
instance Arg Temp where
instance Tuple TempList where
tupleMethods = makeTupleMethods TempList unTempList
instance Arg TempList where
tempList :: [Temp] -> TempList
tempList xs = TempList $ tabList $ fmap unTemp xs
fromTempList :: TempList -> Sig -> Temp
fromTempList (TempList tab) asig = Temp $ fromTabList tab asig
fromTempListD :: TempList -> D -> Temp
fromTempListD (TempList tab) a = Temp $ fromTabListD tab a
cent2ratio :: Floating a => a -> a
cent2ratio x = 2 ** (x / 1200)
ratio2cent :: Floating a => a -> a
ratio2cent x = 1200 * logBase 2 x
equalCents1 = fmap (* 100) [0 .. 12]
justCents1 = fmap ratio2cent [1/1, 16/15, 9/8, 6/5, 5/4, 4/3, 45/32, 3/2, 8/5, 5/3, 9/5, 15/8, 2/1]
meantoneCents = [0, 76.0, 193.2, 310.3, 386.3, 503.4, 579.5, 696.8, 772.6, 889.7, 1006.8, 1082.9, 1200]
pythagorCents = [0, 113.7, 203.9, 294.1, 407.8, 498, 611.7, 702, 792.2, 905.9, 996.1, 1109.8, 1200]
werckmeisterCents = [0, 90.225, 192.18, 294.135, 390.225, 498.045, 588.27, 696.09, 792.18, 888.27, 996.09, 1092.18, 1200]
youngCents1 = [0, 93.9, 195.8, 297.8, 391.7, 499.9, 591.9, 697.9, 795.8, 893.8, 999.8, 1091.8, 1200]
youngCents2 = zipWith (+) equalCents1 [0, 0.1, 2.1, 4, -2.1, 6.1, -1.8, 4.2, 2.1, 0, 6, -2, 0]
youngCents3 = zipWith (+) equalCents1 [0, -3.9, 2, 0, -2, 3.9, -5.9, 3.9, -2, 0, 2, -3.9, 0]
toTemp = tempC
equal1 :: Temp
equal1 = toTemp equalCents1
just1 :: Temp
just1 = toTemp justCents1
meantone :: Temp
meantone = toTemp meantoneCents
pythagor :: Temp
pythagor = toTemp pythagorCents
werckmeister :: Temp
werckmeister = toTemp werckmeisterCents
young1 :: Temp
young1 = toTemp youngCents1
young2 :: Temp
young2 = toTemp youngCents2
young3 :: Temp
young3 = toTemp youngCents3