-- | Shortcuts for common chords.
module Csound.Sam.Chord (
  chTrans, chRot,
    chMin, chMaj, chLead,
    chMaj7, chMin7, ch7, chLead7,
    atMaj, atMin, atMaj7, atMin7
) where

import Csound.Base(int, D)
import Csound.Sam(Chord)

-- | A major chord.
chMaj :: Chord
chMaj :: Chord
chMaj = [D
0, D
4, D
7]

-- | A minor chord
chMin :: Chord
chMin :: Chord
chMin = [D
0, D
3, D
7]

-- | A lead tone triad.
chLead :: Chord
chLead :: Chord
chLead = [D
0, D
3, D
6]

-- |  A dominant seventh chord.
ch7 :: Chord
ch7 :: Chord
ch7 = [D
0, D
4, D
7, D
10]

-- | A major seventh chord.
chMaj7 :: Chord
chMaj7 :: Chord
chMaj7 = [D
0, D
4, D
7, D
11]

-- | A minor seventh chord.
chMin7 :: Chord
chMin7 :: Chord
chMin7 = [D
0, D
3, D
7, D
10]

-- | A lead tone seventh chord.
chLead7 :: Chord
chLead7 :: Chord
chLead7 = [D
0, D
3, D
6, D
10]

chTrans :: D -> Chord -> Chord
chTrans :: D -> Chord -> Chord
chTrans D
k = (D -> D) -> Chord -> Chord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (D
k D -> D -> D
forall a. Num a => a -> a -> a
+ )

-- | Rotates the chord.
chRot :: Int -> Chord -> Chord
chRot :: Int -> Chord -> Chord
chRot Int
m
  | Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Chord -> Chord
forall a. a -> a
id
  | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Int -> Chord -> Chord
forall t a. (Eq t, Num t, Num a) => t -> [a] -> [a]
rotPos Int
m
  | Bool
otherwise = Int -> Chord -> Chord
forall t a. (Eq t, Num t, Num a) => t -> [a] -> [a]
rotNeg (Int -> Int
forall a. Num a => a -> a
abs Int
m)
  where
    rotPos :: t -> [a] -> [a]
rotPos t
1 [a]
xs = [a] -> [a]
forall a. [a] -> [a]
tail [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [[a] -> a
forall a. [a] -> a
head [a]
xs a -> a -> a
forall a. Num a => a -> a -> a
+ a
12]
    rotPos t
n [a]
xs = t -> [a] -> [a]
rotPos (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (t -> [a] -> [a]
rotPos t
1 [a]
xs)

    rotNeg :: t -> [a] -> [a]
rotNeg t
1 [a]
xs = ([a] -> a
forall a. [a] -> a
last [a]
xs a -> a -> a
forall a. Num a => a -> a -> a
- a
12) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
forall a. [a] -> [a]
init [a]
xs
    rotNeg t
n [a]
xs = t -> [a] -> [a]
rotNeg (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (t -> [a] -> [a]
rotNeg t
1 [a]
xs)

toneMsg :: a
toneMsg :: a
toneMsg = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Tone number should belong to interval (0, 6)"

toneMap :: Int -> a -> a -> a -> a -> a -> a -> a -> a
toneMap :: Int -> a -> a -> a -> a -> a -> a -> a -> a
toneMap Int
n a
a0 a
a1 a
a2 a
a3 a
a4 a
a5 a
a6 = case Int
n of
        Int
0 -> a
a0
        Int
1 -> a
a1
        Int
2 -> a
a2
        Int
3 -> a
a3
        Int
4 -> a
a4
        Int
5 -> a
a5
        Int
6 -> a
a6
        Int
_ -> a
forall a. a
toneMsg

-- | Chord in major scale at the given note (if there are seven notes)
atMaj :: Int -> Chord
atMaj :: Int -> Chord
atMaj Int
n = D -> Chord -> Chord
chTrans (Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
oct Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
inMaj Int
tone) (Chord -> Chord) -> Chord -> Chord
forall a b. (a -> b) -> a -> b
$ Int
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
forall a. Int -> a -> a -> a -> a -> a -> a -> a -> a
toneMap Int
tone Chord
chMaj Chord
chMin Chord
chMin Chord
chMaj Chord
chMaj Chord
chMin Chord
chLead
  where (Int
oct, Int
tone) = Int -> (Int, Int)
octTone Int
n

-- | Chord in minor scale at the given note (if there are seven notes)
atMin :: Int -> Chord
atMin :: Int -> Chord
atMin Int
n = D -> Chord -> Chord
chTrans (Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
oct Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
inMin Int
tone) (Chord -> Chord) -> Chord -> Chord
forall a b. (a -> b) -> a -> b
$ Int
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
forall a. Int -> a -> a -> a -> a -> a -> a -> a -> a
toneMap Int
tone Chord
chMin Chord
chLead Chord
chMaj Chord
chMin Chord
chMin Chord
chMaj Chord
chMaj
  where (Int
oct, Int
tone) = Int -> (Int, Int)
octTone Int
n

-- | Seventh chord in major scale at the given note (if there are seven notes)
atMaj7 :: Int -> Chord
atMaj7 :: Int -> Chord
atMaj7 Int
n = D -> Chord -> Chord
chTrans (Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
oct Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
inMaj Int
tone) (Chord -> Chord) -> Chord -> Chord
forall a b. (a -> b) -> a -> b
$ Int
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
forall a. Int -> a -> a -> a -> a -> a -> a -> a -> a
toneMap Int
tone Chord
chMaj7 Chord
chMin7 Chord
chMin7 Chord
chMaj7 Chord
ch7 Chord
chMin7 Chord
chLead7
  where (Int
oct, Int
tone) = Int -> (Int, Int)
octTone Int
n

-- | Seventh chord in minor scale at the given note (if there are seven notes)
atMin7 :: Int -> Chord
atMin7 :: Int -> Chord
atMin7 Int
n = D -> Chord -> Chord
chTrans (Int -> D
int (Int -> D) -> Int -> D
forall a b. (a -> b) -> a -> b
$ Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
oct Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
inMin Int
tone) (Chord -> Chord) -> Chord -> Chord
forall a b. (a -> b) -> a -> b
$ Int
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
-> Chord
forall a. Int -> a -> a -> a -> a -> a -> a -> a -> a
toneMap Int
tone Chord
chMin7 Chord
chLead7 Chord
chMaj7 Chord
chMin7 Chord
chMin7 Chord
chMaj7 Chord
ch7
  where (Int
oct, Int
tone) = Int -> (Int, Int)
octTone Int
n

inMaj :: Int -> Int
inMaj :: Int -> Int
inMaj Int
x = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
forall a. Int -> a -> a -> a -> a -> a -> a -> a -> a
toneMap Int
x Int
0 Int
2 Int
4 Int
5 Int
7 Int
9 Int
11

inMin :: Int -> Int
inMin :: Int -> Int
inMin Int
x = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
forall a. Int -> a -> a -> a -> a -> a -> a -> a -> a
toneMap Int
x Int
0 Int
2 Int
3 Int
5 Int
7 Int
9 Int
10

octTone :: Int -> (Int, Int)
octTone :: Int -> (Int, Int)
octTone Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = (Int
oct Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
tone Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
  | Bool
otherwise = (Int
oct, Int
tone)
  where (Int
oct, Int
tone) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
7