-- | Anamark tuning (TUN) files
--
-- <https://www.mark-henning.de/files/am/Tuning_File_V2_Doc.pdf>
module Music.Theory.Tuning.Anamark where

import Text.Printf {- base -}

import qualified Music.Theory.List as T

-- | Format section string
tun_sec :: String -> String
tun_sec :: String -> String
tun_sec = forall r. PrintfType r => String -> r
printf String
"[%s]"

-- | Format 'String' (text) attribute
tun_attr_txt :: (String,String) -> String
tun_attr_txt :: (String, String) -> String
tun_attr_txt (String
k,String
v) = forall r. PrintfType r => String -> r
printf String
"%s = \"%s\"" String
k String
v

-- | Format 'Int' attribute
tun_attr_int :: (String,Int) -> String
tun_attr_int :: (String, Int) -> String
tun_attr_int (String
k,Int
v) = forall r. PrintfType r => String -> r
printf String
"%s = %d" String
k Int
v

-- | Format 'Double' attribute
tun_attr_real :: (String,Double) -> String
tun_attr_real :: (String, Double) -> String
tun_attr_real (String
k,Double
v) = forall r. PrintfType r => String -> r
printf String
"%s = %f" String
k Double
v

-- | TUN V.200 /Scale Begin/ (header) section.
tun_begin :: [String]
tun_begin :: [String]
tun_begin =
  [String -> String
tun_sec String
"Scale Begin"
  ,(String, String) -> String
tun_attr_txt (String
"Format",String
"AnaMark-TUN")
  ,(String, Int) -> String
tun_attr_int (String
"FormatVersion",Int
200)
  ,(String, String) -> String
tun_attr_txt (String
"FormatSpecs",String
"http://www.mark-henning.de/eternity/tuningspecs.html")]

-- | Format /Info/ section given Name and ID (the only required fields).
--
-- > tun_info ("name","id")
tun_info :: (String,String) -> [String]
tun_info :: (String, String) -> [String]
tun_info (String
nm,String
k) =
  [String -> String
tun_sec String
"Info"
  ,(String, String) -> String
tun_attr_txt (String
"Name",String
nm)
  ,(String, String) -> String
tun_attr_txt (String
"ID",String
k)]

-- | Format /Tuning/ section given sequence of 128 integral cents values.
--
-- > tun_tuning [0,100.. 12700]
tun_tuning :: [Int] -> [String]
tun_tuning :: [Int] -> [String]
tun_tuning =
  let f :: t -> t -> t
f t
k t
c = forall r. PrintfType r => String -> r
printf String
"note %d = %d" t
k t
c
  in (:) (String -> String
tun_sec String
"Tuning") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t} {t} {t}.
(PrintfArg t, PrintfArg t, PrintfType t) =>
t -> t -> t
f [Int
0::Int .. Int
127]

-- | The default base frequency for /Exact Tuning/ (A4=440)
tun_f0_default :: Double
tun_f0_default :: Double
tun_f0_default = Double
8.1757989156437073336

-- | Format /Exact Tuning/ section given base frequency and sequence of 128 real cents values.
--
-- > tun_exact_tuning tun_f0_default [0,100.. 12700]
tun_exact_tuning :: Double -> [Double] -> [String]
tun_exact_tuning :: Double -> [Double] -> [String]
tun_exact_tuning Double
f0 =
  let f :: t -> t -> t
f t
k t
c = forall r. PrintfType r => String -> r
printf String
"note %d = %f" t
k t
c
      hdr :: [String]
hdr = [String -> String
tun_sec String
"Exact Tuning"
            ,(String, Double) -> String
tun_attr_real (String
"BaseFreq",Double
f0)]
  in forall a. [a] -> [a] -> [a]
(++) [String]
hdr  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t} {t} {t}.
(PrintfArg t, PrintfArg t, PrintfType t) =>
t -> t -> t
f [Int
0::Int .. Int
127]

{- | Format /Functional Tuning/ section given base frequency and sequence of 128 real cents values.

This simply sets note zero to /f0/ and increments each note by the difference from the previous note.

> tun_functional_tuning tun_f0_default [0,100.. 12700]
-}
tun_functional_tuning :: Double -> [Double] -> [String]
tun_functional_tuning :: Double -> [Double] -> [String]
tun_functional_tuning Double
f0 =
  let f :: t -> t -> t
f t
k t
c = forall r. PrintfType r => String -> r
printf String
"note %d = \"#x=%d %% %f\"" t
k (t
k forall a. Num a => a -> a -> a
- t
1) t
c
      hdr :: [String]
hdr = [String -> String
tun_sec String
"Functional Tuning"
            ,forall r. PrintfType r => String -> r
printf String
"note 0 = \"# %f\"" Double
f0]
  in forall a. [a] -> [a] -> [a]
(++) [String]
hdr  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t} {t} {t}.
(PrintfArg t, PrintfArg t, PrintfType t, Num t) =>
t -> t -> t
f [Int
1::Int .. Int
127] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => [a] -> [a]
T.d_dx

-- | Format /Scale End/ section header.
tun_end :: [String]
tun_end :: [String]
tun_end =
  [String -> String
tun_sec String
"Scale End"]

-- | Synonym for a list of strings.
type TUN = [String]

-- | Version 1 has just the /Tuning/ and /Exact Tuning/.
tun_from_cents_version_one :: (Double, [Double]) -> TUN
tun_from_cents_version_one :: (Double, [Double]) -> [String]
tun_from_cents_version_one (Double
f0,[Double]
c) =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int] -> [String]
tun_tuning (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (RealFrac a, Integral b) => a -> b
round [Double]
c)
         ,Double -> [Double] -> [String]
tun_exact_tuning Double
f0 [Double]
c]

-- | Version 2 files have, in addition, /Begin/, /Info/, /Functional Tuning/ and /End/ sections.
tun_from_cents_version_two :: (String,String) -> (Double, [Double]) -> TUN
tun_from_cents_version_two :: (String, String) -> (Double, [Double]) -> [String]
tun_from_cents_version_two (String
nm,String
k) (Double
f0,[Double]
c) =
  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]
tun_begin
         ,(String, String) -> [String]
tun_info (String
nm,String
k)
         ,[Int] -> [String]
tun_tuning (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (RealFrac a, Integral b) => a -> b
round [Double]
c)
         ,Double -> [Double] -> [String]
tun_exact_tuning Double
f0 [Double]
c
         ,Double -> [Double] -> [String]
tun_functional_tuning Double
f0 [Double]
c
         ,[String]
tun_end]

-- > t = tun_from_cents_version_one (tun_f0_default,[0,100 .. 12700])
-- > t = tun_from_cents_version_two ("equal-temperament-12","et12") (tun_f0_default,[0,100 .. 12700])
-- > tun_store "/home/rohan/et12.tun" t
tun_store :: FilePath -> TUN -> IO ()
tun_store :: String -> [String] -> IO ()
tun_store String
fn = String -> String -> IO ()
writeFile String
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines