module Sound.Conductive.Scale where
import Data.List
import Sound.Conductive.MiscListUtils
import Sound.Conductive.MusicalTime
import Sound.Conductive.Pitch
chromaticRel = [1,1,1,1,1,1,1,1,1,1]
ionianRel :: [Integer]
ionianRel = [ 2, 2, 1, 2, 2, 2, 1 ]
dorianRel :: [Integer]
dorianRel = [ 2, 1, 2, 2, 2, 1, 2 ]
phrygianRel :: [Integer]
phrygianRel = [ 1, 2, 2, 2, 1, 2, 2 ]
lydianRel :: [Integer]
lydianRel = [ 2, 2, 2, 1, 2, 2, 1 ]
mixolydianRel :: [Integer]
mixolydianRel = [ 2, 2, 1, 2, 2, 1, 2 ]
aeolianRel :: [Integer]
aeolianRel = [ 2, 1, 2, 2, 1, 2, 2 ]
locrianRel :: [Integer]
locrianRel = [ 1, 2, 2, 1, 2, 2, 2 ]
absoluteScaleMaker :: (Num a) => [a] -> Int -> a -> [a]
absoluteScaleMaker scale n startingNote =
take n $ deltasToAbsolutes startingNote $ cycle scale
chromatic = absoluteScaleMaker chromaticRel
ionian :: Int -> Integer -> [Integer]
ionian = absoluteScaleMaker ionianRel
dorian :: Int -> Integer -> [Integer]
dorian = absoluteScaleMaker dorianRel
phrygian :: Int -> Integer -> [Integer]
phrygian = absoluteScaleMaker phrygianRel
lydian :: Int -> Integer -> [Integer]
lydian = absoluteScaleMaker lydianRel
mixolydian :: Int -> Integer -> [Integer]
mixolydian = absoluteScaleMaker mixolydianRel
aeolian :: Int -> Integer -> [Integer]
aeolian = absoluteScaleMaker aeolianRel
locrian :: Int -> Integer -> [Integer]
locrian = absoluteScaleMaker locrianRel
bilawalRel :: [Integer]
bilawalRel = ionianRel
khamajRel :: [Integer]
khamajRel = mixolydianRel
kafiRel :: [Integer]
kafiRel = dorianRel
asavariRel :: [Integer]
asavariRel = aeolianRel
bhairaviRel :: [Integer]
bhairaviRel = phrygianRel
bhairavRel :: [Integer]
bhairavRel = [ 1, 3, 1, 2, 1, 3, 1 ]
kalyanRel :: [Integer]
kalyanRel = lydianRel
marwaRel :: [Integer]
marwaRel = [ 1, 3, 2, 1, 2, 2, 1 ]
poorviRel :: [Integer]
poorviRel = [ 1, 3, 2, 1, 1, 3, 1 ]
todiRel :: [Integer]
todiRel = [ 1, 2, 3, 1, 1, 3, 1 ]
bilawal :: Int -> Integer -> [Integer]
bilawal = ionian
khamaj :: Int -> Integer -> [Integer]
khamaj = mixolydian
kafi :: Int -> Integer -> [Integer]
kafi = dorian
asavari :: Int -> Integer -> [Integer]
asavari = aeolian
bhairavi :: Int -> Integer -> [Integer]
bhairavi = phrygian
bhairav :: Int -> Integer -> [Integer]
bhairav = absoluteScaleMaker bhairavRel
kalyan :: Int -> Integer -> [Integer]
kalyan = absoluteScaleMaker kalyanRel
marwa :: Int -> Integer -> [Integer]
marwa = absoluteScaleMaker marwaRel
poorvi :: Int -> Integer -> [Integer]
poorvi = absoluteScaleMaker poorviRel
todi :: Int -> Integer -> [Integer]
todi = absoluteScaleMaker todiRel
mold' :: (Num a, Ord a) => [a] -> [a] -> [a] -> [a]
mold' xs o y
| y == [] = o
| elem (y!!0) xs == True = y++o
| elem (y!!0) xs == False =
let a = span ((>) (y!!0)) xs
b = if ((fst a) == []) then head xs else last $ fst a
c = if ((snd a) == []) then last xs else head $ snd a
d = (y!!0) b
e = c (y!!0)
in if (d > e) then c:o else b:o
mold :: (Num a, Ord a) => [a] -> [a] -> a -> [a]
mold xs o y =
let a = [y]
in mold' xs o a
fitToScale :: (Num b, Ord b) => [b] -> [b] -> [b]
fitToScale scale input = reverse $ foldl (\x y -> mold scale x y) [] input
rawToScaleDegrees scale rs = fitToScale scale $ map convRaw rs where
scaleMin = head scale
scaleMax = last scale
scaleRange = scaleMax scaleMin
convRaw x = (x * scaleRange) + scaleMin
transpose :: (Num a) => a -> [a] -> [a]
transpose n xs = map (\x -> x + n) xs
transposeHeadTo :: (Num a) => a -> [a] -> [a]
transposeHeadTo n xs = map (+(n (head xs))) xs
maxInterval' :: (Fractional a, Ord a) => a -> [a] -> [a] -> [a]
maxInterval' n xs o
| xs == [] = o
| o == [] = maxInterval' n (tail xs) $ o ++ [head xs]
| (abs $ (last o) (head xs)) <= n = maxInterval' n (tail xs) $ o ++ [head xs]
| (abs $ (last o) (head xs)) > n =
let diff = (last o) (head xs)
sign = diff/(abs diff)
newHead = (+) (head xs) $ ((abs diff) n) * sign
in maxInterval' n (tail xs) $ o ++ [newHead]
maxInterval :: (Fractional a, Ord a) => a -> [a] -> [a]
maxInterval n xs = maxInterval' n xs []