-- | Syntonic tuning.
module Music.Theory.Tuning.Syntonic where

import Data.List {- base -}

import qualified Music.Theory.Tuning as T {- hmt -}
import qualified Music.Theory.Tuning.Type as T {- hmt -}

{- | Construct an isomorphic layout of /r/ rows and /c/ columns with an upper left value of /(i,j)/.

> r = [[(0,0),(-1,2),(-2,4)],[(-1,1),(-2,3),(-3,5)],[(-2,2),(-3,4),(-4,6)]]
> mk_isomorphic_layout 3 3 (0,0) == r
> map (map fst) r == [[0,-1,-2],[-1,-2,-3],[-2,-3,-4]]
> map (map snd) r == [[0,2,4],[1,3,5],[2,4,6]]
> map (map fst) r == map (map fst) (transpose r)
> map (map snd) (transpose r) == [[0,1,2],[2,3,4],[4,5,6]]
-}
mk_isomorphic_layout :: Integral a => a -> a -> (a,a) -> [[(a,a)]]
mk_isomorphic_layout :: forall a. Integral a => a -> a -> (a, a) -> [[(a, a)]]
mk_isomorphic_layout a
n_row a
n_col (a, a)
top_left =
    let (a
a,b
b) plus :: (a, b) -> (a, b) -> (a, b)
`plus` (a
c,b
d) = (a
aforall a. Num a => a -> a -> a
+a
c,b
bforall a. Num a => a -> a -> a
+b
d)
        mk_seq :: t -> (a, b) -> (a, b) -> [(a, b)]
mk_seq t
0 (a, b)
_ (a, b)
_ = []
        mk_seq t
n (a, b)
i (a, b)
z = (a, b)
z forall a. a -> [a] -> [a]
: t -> (a, b) -> (a, b) -> [(a, b)]
mk_seq (t
nforall a. Num a => a -> a -> a
-t
1) (a, b)
i ((a, b)
z forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
`plus` (a, b)
i)
        left :: [(a, a)]
left = forall {t} {a} {b}.
(Eq t, Num t, Num a, Num b) =>
t -> (a, b) -> (a, b) -> [(a, b)]
mk_seq a
n_row (-a
1,a
1) (a, a)
top_left
    in forall a b. (a -> b) -> [a] -> [b]
map (forall {t} {a} {b}.
(Eq t, Num t, Num a, Num b) =>
t -> (a, b) -> (a, b) -> [(a, b)]
mk_seq a
n_col (-a
1,a
2)) [(a, a)]
left

-- | A minimal isomorphic note layout.
--
-- > let [i,j,k] = mk_isomorphic_layout 3 5 (3,-4)
-- > [i,take 4 j,(2,-4):take 4 k] == minimal_isomorphic_note_layout
minimal_isomorphic_note_layout :: [[(Int,Int)]]
minimal_isomorphic_note_layout :: [[(Int, Int)]]
minimal_isomorphic_note_layout =
  [[(Int
3,-Int
4),(Int
2,-Int
2),(Int
1,Int
0),(Int
0,Int
2),(-Int
1,Int
4)]
  ,[(Int
2,-Int
3),(Int
1,-Int
1),(Int
0,Int
1),(-Int
1,Int
3)]
  ,[(Int
2,-Int
4),(Int
1,-Int
2),(Int
0,Int
0),(-Int
1,Int
2),(-Int
2,Int
4)]]

-- | Make a rank two regular temperament from a list of /(i,j)/
-- positions by applying the scalars /a/ and /b/.
rank_two_regular_temperament :: Integral a => a -> a -> [(a,a)] -> [a]
rank_two_regular_temperament :: forall a. Integral a => a -> a -> [(a, a)] -> [a]
rank_two_regular_temperament a
a a
b = let f :: (a, a) -> a
f (a
i,a
j) = a
i forall a. Num a => a -> a -> a
* a
a forall a. Num a => a -> a -> a
+ a
j forall a. Num a => a -> a -> a
* a
b in forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
f

-- | Syntonic tuning system based on 'mk_isomorphic_layout' of @5@
-- rows and @7@ columns starting at @(3,-4)@ and a
-- 'rank_two_regular_temperament' with /a/ of @1200@ and indicated
-- /b/.
mk_syntonic_tuning :: Int -> [T.Cents]
mk_syntonic_tuning :: Int -> [Cents]
mk_syntonic_tuning Int
b =
  let l :: [[(Int, Int)]]
l = forall a. Integral a => a -> a -> (a, a) -> [[(a, a)]]
mk_isomorphic_layout Int
5 Int
7 (Int
3,-Int
4)
      t :: [[Int]]
t = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Integral a => a -> a -> [(a, a)] -> [a]
rank_two_regular_temperament Int
1200 Int
b) [[(Int, Int)]]
l
  in forall a. Eq a => [a] -> [a]
nub (forall a. Ord a => [a] -> [a]
sort (forall a b. (a -> b) -> [a] -> [b]
map (\Int
x -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Integral a => a -> a -> a
`mod` Int
1200)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int]]
t)))

{- | 'mk_syntonic_tuning' of @697@.

> tn_divisions syntonic_697 == 17

> let c = [0,79,194,273,309,388,467,503,582,697,776,812,891,970,1006,1085,1164]
> tn_cents_i syntonic_697 == c
-}
syntonic_697 :: T.Tuning
syntonic_697 :: Tuning
syntonic_697 = Either [Rational] [Cents]
-> Maybe (Either Rational Cents) -> Tuning
T.Tuning (forall a b. b -> Either a b
Right (Int -> [Cents]
mk_syntonic_tuning Int
697)) forall a. Maybe a
Nothing

-- | 'mk_syntonic_tuning' of @702@.
--
-- > tn_divisions syntonic_702 == 17
--
-- > let c = [0,24,114,204,294,318,408,498,522,612,702,792,816,906,996,1020,1110]
-- > tn_cents_i syntonic_702 == c
syntonic_702 :: T.Tuning
syntonic_702 :: Tuning
syntonic_702 = Either [Rational] [Cents]
-> Maybe (Either Rational Cents) -> Tuning
T.Tuning (forall a b. b -> Either a b
Right (Int -> [Cents]
mk_syntonic_tuning Int
702)) forall a. Maybe a
Nothing