module Sound.Tidal.Scales (scale, scaleList, scaleTable, getScale) where

import Prelude hiding ((<*), (*>))
import Data.Maybe
import Sound.Tidal.Pattern
import Sound.Tidal.Utils

-- five notes scales
minPent :: Fractional a => [a]
minPent :: [a]
minPent = [0,3,5,7,10]
majPent :: Fractional a => [a]
majPent :: [a]
majPent = [0,2,4,7,9]

--  another mode of major pentatonic
ritusen :: Fractional a => [a]
ritusen :: [a]
ritusen = [0,2,5,7,9]

-- another mode of major pentatonic
egyptian :: Fractional a => [a]
egyptian :: [a]
egyptian = [0,2,5,7,10]

--
kumai :: Fractional a => [a]
kumai :: [a]
kumai = [0,2,3,7,9]
hirajoshi :: Fractional a => [a]
hirajoshi :: [a]
hirajoshi = [0,2,3,7,8]
iwato :: Fractional a => [a]
iwato :: [a]
iwato = [0,1,5,6,10]
chinese :: Fractional a => [a]
chinese :: [a]
chinese = [0,4,6,7,11]
indian :: Fractional a => [a]
indian :: [a]
indian = [0,4,5,7,10]
pelog :: Fractional a => [a]
pelog :: [a]
pelog = [0,1,3,7,8]

--
prometheus :: Fractional a => [a]
prometheus :: [a]
prometheus = [0,2,4,6,11]
scriabin :: Fractional a => [a]
scriabin :: [a]
scriabin = [0,1,4,7,9]

-- han chinese pentatonic scales
gong :: Fractional a => [a]
gong :: [a]
gong = [0,2,4,7,9]
shang :: Fractional a => [a]
shang :: [a]
shang = [0,2,5,7,10]
jiao :: Fractional a => [a]
jiao :: [a]
jiao = [0,3,5,8,10]
zhi :: Fractional a => [a]
zhi :: [a]
zhi = [0,2,5,7,9]
yu :: Fractional a => [a]
yu :: [a]
yu = [0,3,5,7,10]

-- 6 note scales
whole' :: Fractional a => [a]
whole' :: [a]
whole' = [0,2,4,6,8,10]
augmented :: Fractional a => [a]
augmented :: [a]
augmented = [0,3,4,7,8,11]
augmented2 :: Fractional a => [a]
augmented2 :: [a]
augmented2 = [0,1,4,5,8,9]

-- hexatonic modes with no tritone
hexMajor7 :: Fractional a => [a]
hexMajor7 :: [a]
hexMajor7 = [0,2,4,7,9,11]
hexDorian :: Fractional a => [a]
hexDorian :: [a]
hexDorian = [0,2,3,5,7,10]
hexPhrygian :: Fractional a => [a]
hexPhrygian :: [a]
hexPhrygian = [0,1,3,5,8,10]
hexSus :: Fractional a => [a]
hexSus :: [a]
hexSus = [0,2,5,7,9,10]
hexMajor6 :: Fractional a => [a]
hexMajor6 :: [a]
hexMajor6 = [0,2,4,5,7,9]
hexAeolian :: Fractional a => [a]
hexAeolian :: [a]
hexAeolian = [0,3,5,7,8,10]

-- 7 note scales
major :: Fractional a => [a]
major :: [a]
major = [0,2,4,5,7,9,11]
ionian :: Fractional a => [a]
ionian :: [a]
ionian = [0,2,4,5,7,9,11]
dorian :: Fractional a => [a]
dorian :: [a]
dorian = [0,2,3,5,7,9,10]
phrygian :: Fractional a => [a]
phrygian :: [a]
phrygian = [0,1,3,5,7,8,10]
lydian :: Fractional a => [a]
lydian :: [a]
lydian = [0,2,4,6,7,9,11]
mixolydian :: Fractional a => [a]
mixolydian :: [a]
mixolydian = [0,2,4,5,7,9,10]
aeolian :: Fractional a => [a]
aeolian :: [a]
aeolian = [0,2,3,5,7,8,10]
minor :: Fractional a => [a]
minor :: [a]
minor = [0,2,3,5,7,8,10]
locrian :: Fractional a => [a]
locrian :: [a]
locrian = [0,1,3,5,6,8,10]
harmonicMinor :: Fractional a => [a]
harmonicMinor :: [a]
harmonicMinor = [0,2,3,5,7,8,11]
harmonicMajor :: Fractional a => [a]
harmonicMajor :: [a]
harmonicMajor = [0,2,4,5,7,8,11]
melodicMinor :: Fractional a => [a]
melodicMinor :: [a]
melodicMinor = [0,2,3,5,7,9,11]
melodicMinorDesc :: Fractional a => [a]
melodicMinorDesc :: [a]
melodicMinorDesc = [0,2,3,5,7,8,10]
melodicMajor :: Fractional a => [a]
melodicMajor :: [a]
melodicMajor = [0,2,4,5,7,8,10]
bartok :: Fractional a => [a]
bartok :: [a]
bartok = [a]
forall a. Fractional a => [a]
melodicMajor
hindu :: Fractional a => [a]
hindu :: [a]
hindu = [a]
forall a. Fractional a => [a]
melodicMajor

-- raga modes
todi :: Fractional a => [a]
todi :: [a]
todi = [0,1,3,6,7,8,11]
purvi :: Fractional a => [a]
purvi :: [a]
purvi = [0,1,4,6,7,8,11]
marva :: Fractional a => [a]
marva :: [a]
marva = [0,1,4,6,7,9,11]
bhairav :: Fractional a => [a]
bhairav :: [a]
bhairav = [0,1,4,5,7,8,11]
ahirbhairav :: Fractional a => [a]
ahirbhairav :: [a]
ahirbhairav = [0,1,4,5,7,9,10]

--
superLocrian :: Fractional a => [a]
superLocrian :: [a]
superLocrian = [0,1,3,4,6,8,10]
romanianMinor :: Fractional a => [a]
romanianMinor :: [a]
romanianMinor = [0,2,3,6,7,9,10]
hungarianMinor :: Fractional a => [a]
hungarianMinor :: [a]
hungarianMinor = [0,2,3,6,7,8,11]
neapolitanMinor :: Fractional a => [a]
neapolitanMinor :: [a]
neapolitanMinor = [0,1,3,5,7,8,11]
enigmatic :: Fractional a => [a]
enigmatic :: [a]
enigmatic = [0,1,4,6,8,10,11]
spanish :: Fractional a => [a]
spanish :: [a]
spanish = [0,1,4,5,7,8,10]

-- modes of whole tones with added note ->
leadingWhole :: Fractional a => [a]
leadingWhole :: [a]
leadingWhole = [0,2,4,6,8,10,11]
lydianMinor :: Fractional a => [a]
lydianMinor :: [a]
lydianMinor = [0,2,4,6,7,8,10]
neapolitanMajor :: Fractional a => [a]
neapolitanMajor :: [a]
neapolitanMajor = [0,1,3,5,7,9,11]
locrianMajor :: Fractional a => [a]
locrianMajor :: [a]
locrianMajor = [0,2,4,5,6,8,10]

-- 8 note scales
diminished :: Fractional a => [a]
diminished :: [a]
diminished = [0,1,3,4,6,7,9,10]
diminished2 :: Fractional a => [a]
diminished2 :: [a]
diminished2 = [0,2,3,5,6,8,9,11]

-- modes of limited transposition
messiaen1 :: Fractional a => [a]
messiaen1 :: [a]
messiaen1 = [a]
forall a. Fractional a => [a]
whole'
messiaen2 :: Fractional a => [a]
messiaen2 :: [a]
messiaen2 = [a]
forall a. Fractional a => [a]
diminished
messiaen3 :: Fractional a => [a]
messiaen3 :: [a]
messiaen3 = [0, 2, 3, 4, 6, 7, 8, 10, 11]
messiaen4 :: Fractional a => [a]
messiaen4 :: [a]
messiaen4 = [0, 1, 2, 5, 6, 7, 8, 11]
messiaen5 :: Fractional a => [a]
messiaen5 :: [a]
messiaen5 = [0, 1, 5, 6, 7, 11]
messiaen6 :: Fractional a => [a]
messiaen6 :: [a]
messiaen6 = [0, 2, 4, 5, 6, 8, 10, 11]
messiaen7 :: Fractional a => [a]
messiaen7 :: [a]
messiaen7 = [0, 1, 2, 3, 5, 6, 7, 8, 9, 11]

-- Arabic maqams taken from SuperCollider's Scale.sc
bayati :: Fractional a => [a]
bayati :: [a]
bayati = [0, 1.5, 3, 5, 7, 8, 10]
hijaz :: Fractional a => [a]
hijaz :: [a]
hijaz = [0, 1, 4, 5, 7, 8.5, 10]
sikah :: Fractional a => [a]
sikah :: [a]
sikah = [0, 1.5, 3.5, 5.5, 7, 8.5, 10.5]
rast :: Fractional a => [a]
rast :: [a]
rast = [0, 2, 3.5, 5, 7, 9, 10.5]
iraq :: Fractional a => [a]
iraq :: [a]
iraq = [0, 1.5, 3.5, 5, 6.5, 8.5, 10.5]
saba :: Fractional a => [a]
saba :: [a]
saba = [0, 1.5, 3, 4, 6, 8, 10]

-- 12 note scales
chromatic :: Fractional a => [a]
chromatic :: [a]
chromatic = [0,1,2,3,4,5,6,7,8,9,10,11]

scale :: Fractional a => Pattern String -> Pattern Int -> Pattern a
scale :: Pattern String -> Pattern Int -> Pattern a
scale = [(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
forall a.
Fractional a =>
[(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
getScale [(String, [a])]
forall a. Fractional a => [(String, [a])]
scaleTable

getScale :: Fractional a => [(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
getScale :: [(String, [a])] -> Pattern String -> Pattern Int -> Pattern a
getScale table :: [(String, [a])]
table sp :: Pattern String
sp p :: Pattern Int
p = (\n :: Int
n scaleName :: String
scaleName
              -> [a] -> Int -> a
forall a. Num a => [a] -> Int -> a
noteInScale ([a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [0] (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ String -> [(String, [a])] -> Maybe [a]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
scaleName [(String, [a])]
table) Int
n) (Int -> String -> a) -> Pattern Int -> Pattern (String -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
p Pattern (String -> a) -> Pattern String -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern String
sp
  where octave :: t a -> Int -> Int
octave s :: t a
s x :: Int
x = Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
s
        noteInScale :: [a] -> Int -> a
noteInScale s :: [a]
s x :: Int
x = ([a]
s [a] -> Int -> a
forall a. [a] -> Int -> a
!!! Int
x) a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [a] -> Int -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int -> Int
octave [a]
s Int
x)

scaleList :: String
scaleList :: String
scaleList = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, [Rational]) -> String)
-> [(String, [Rational])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Rational]) -> String
forall a b. (a, b) -> a
fst ([(String, [Rational])]
forall a. Fractional a => [(String, [a])]
scaleTable :: [(String, [Rational])])

scaleTable :: Fractional a => [(String, [a])]
scaleTable :: [(String, [a])]
scaleTable = [("minPent", [a]
forall a. Fractional a => [a]
minPent),
              ("majPent", [a]
forall a. Fractional a => [a]
majPent),
              ("ritusen", [a]
forall a. Fractional a => [a]
ritusen),
              ("egyptian", [a]
forall a. Fractional a => [a]
egyptian),
              ("kumai", [a]
forall a. Fractional a => [a]
kumai),
              ("hirajoshi", [a]
forall a. Fractional a => [a]
hirajoshi),
              ("iwato", [a]
forall a. Fractional a => [a]
iwato),
              ("chinese", [a]
forall a. Fractional a => [a]
chinese),
              ("indian", [a]
forall a. Fractional a => [a]
indian),
              ("pelog", [a]
forall a. Fractional a => [a]
pelog),
              ("prometheus", [a]
forall a. Fractional a => [a]
prometheus),
              ("scriabin", [a]
forall a. Fractional a => [a]
scriabin),
              ("gong", [a]
forall a. Fractional a => [a]
gong),
              ("shang", [a]
forall a. Fractional a => [a]
shang),
              ("jiao", [a]
forall a. Fractional a => [a]
jiao),
              ("zhi", [a]
forall a. Fractional a => [a]
zhi),
              ("yu", [a]
forall a. Fractional a => [a]
yu),
              ("whole", [a]
forall a. Fractional a => [a]
whole'),
              ("wholetone", [a]
forall a. Fractional a => [a]
whole'),
              ("augmented", [a]
forall a. Fractional a => [a]
augmented),
              ("augmented2", [a]
forall a. Fractional a => [a]
augmented2),
              ("hexMajor7", [a]
forall a. Fractional a => [a]
hexMajor7),
              ("hexDorian", [a]
forall a. Fractional a => [a]
hexDorian),
              ("hexPhrygian", [a]
forall a. Fractional a => [a]
hexPhrygian),
              ("hexSus", [a]
forall a. Fractional a => [a]
hexSus),
              ("hexMajor6", [a]
forall a. Fractional a => [a]
hexMajor6),
              ("hexAeolian", [a]
forall a. Fractional a => [a]
hexAeolian),
              ("major", [a]
forall a. Fractional a => [a]
major),
              ("ionian", [a]
forall a. Fractional a => [a]
ionian),
              ("dorian", [a]
forall a. Fractional a => [a]
dorian),
              ("phrygian", [a]
forall a. Fractional a => [a]
phrygian),
              ("lydian", [a]
forall a. Fractional a => [a]
lydian),
              ("mixolydian", [a]
forall a. Fractional a => [a]
mixolydian),
              ("aeolian", [a]
forall a. Fractional a => [a]
aeolian),
              ("minor", [a]
forall a. Fractional a => [a]
minor),
              ("locrian", [a]
forall a. Fractional a => [a]
locrian),
              ("harmonicMinor", [a]
forall a. Fractional a => [a]
harmonicMinor),
              ("harmonicMajor", [a]
forall a. Fractional a => [a]
harmonicMajor),
              ("melodicMinor", [a]
forall a. Fractional a => [a]
melodicMinor),
              ("melodicMinorDesc", [a]
forall a. Fractional a => [a]
melodicMinorDesc),
              ("melodicMajor", [a]
forall a. Fractional a => [a]
melodicMajor),
              ("bartok", [a]
forall a. Fractional a => [a]
bartok),
              ("hindu", [a]
forall a. Fractional a => [a]
hindu),
              ("todi", [a]
forall a. Fractional a => [a]
todi),
              ("purvi", [a]
forall a. Fractional a => [a]
purvi),
              ("marva", [a]
forall a. Fractional a => [a]
marva),
              ("bhairav", [a]
forall a. Fractional a => [a]
bhairav),
              ("ahirbhairav", [a]
forall a. Fractional a => [a]
ahirbhairav),
              ("superLocrian", [a]
forall a. Fractional a => [a]
superLocrian),
              ("romanianMinor", [a]
forall a. Fractional a => [a]
romanianMinor),
              ("hungarianMinor", [a]
forall a. Fractional a => [a]
hungarianMinor),
              ("neapolitanMinor", [a]
forall a. Fractional a => [a]
neapolitanMinor),
              ("enigmatic", [a]
forall a. Fractional a => [a]
enigmatic),
              ("spanish", [a]
forall a. Fractional a => [a]
spanish),
              ("leadingWhole", [a]
forall a. Fractional a => [a]
leadingWhole),
              ("lydianMinor", [a]
forall a. Fractional a => [a]
lydianMinor),
              ("neapolitanMajor", [a]
forall a. Fractional a => [a]
neapolitanMajor),
              ("locrianMajor", [a]
forall a. Fractional a => [a]
locrianMajor),
              ("diminished", [a]
forall a. Fractional a => [a]
diminished),
              ("octatonic", [a]
forall a. Fractional a => [a]
diminished),
              ("diminished2", [a]
forall a. Fractional a => [a]
diminished2),
              ("octatonic2", [a]
forall a. Fractional a => [a]
diminished2),
              ("messiaen1", [a]
forall a. Fractional a => [a]
messiaen1),
              ("messiaen2", [a]
forall a. Fractional a => [a]
messiaen2),
              ("messiaen3", [a]
forall a. Fractional a => [a]
messiaen3),
              ("messiaen4", [a]
forall a. Fractional a => [a]
messiaen4),
              ("messiaen5", [a]
forall a. Fractional a => [a]
messiaen5),
              ("messiaen6", [a]
forall a. Fractional a => [a]
messiaen6),
              ("messiaen7", [a]
forall a. Fractional a => [a]
messiaen7),
              ("chromatic", [a]
forall a. Fractional a => [a]
chromatic),
              ("bayati", [a]
forall a. Fractional a => [a]
bayati),
              ("hijaz", [a]
forall a. Fractional a => [a]
hijaz),
              ("sikah", [a]
forall a. Fractional a => [a]
sikah),
              ("rast", [a]
forall a. Fractional a => [a]
rast),
              ("saba", [a]
forall a. Fractional a => [a]
saba),
              ("iraq", [a]
forall a. Fractional a => [a]
iraq)
             ]