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

{-
    Scale.hs - Scales for TidalCycles
    Copyright (C) 2020, lvm (Mauro) and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

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

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

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

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

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

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

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

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

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

-- 7 note scales
major :: Fractional a => [a]
major :: [a]
major = [a
0,a
2,a
4,a
5,a
7,a
9,a
11]
ionian :: Fractional a => [a]
ionian :: [a]
ionian = [a
0,a
2,a
4,a
5,a
7,a
9,a
11]
dorian :: Fractional a => [a]
dorian :: [a]
dorian = [a
0,a
2,a
3,a
5,a
7,a
9,a
10]
phrygian :: Fractional a => [a]
phrygian :: [a]
phrygian = [a
0,a
1,a
3,a
5,a
7,a
8,a
10]
lydian :: Fractional a => [a]
lydian :: [a]
lydian = [a
0,a
2,a
4,a
6,a
7,a
9,a
11]
mixolydian :: Fractional a => [a]
mixolydian :: [a]
mixolydian = [a
0,a
2,a
4,a
5,a
7,a
9,a
10]
aeolian :: Fractional a => [a]
aeolian :: [a]
aeolian = [a
0,a
2,a
3,a
5,a
7,a
8,a
10]
minor :: Fractional a => [a]
minor :: [a]
minor = [a
0,a
2,a
3,a
5,a
7,a
8,a
10]
locrian :: Fractional a => [a]
locrian :: [a]
locrian = [a
0,a
1,a
3,a
5,a
6,a
8,a
10]
harmonicMinor :: Fractional a => [a]
harmonicMinor :: [a]
harmonicMinor = [a
0,a
2,a
3,a
5,a
7,a
8,a
11]
harmonicMajor :: Fractional a => [a]
harmonicMajor :: [a]
harmonicMajor = [a
0,a
2,a
4,a
5,a
7,a
8,a
11]
melodicMinor :: Fractional a => [a]
melodicMinor :: [a]
melodicMinor = [a
0,a
2,a
3,a
5,a
7,a
9,a
11]
melodicMinorDesc :: Fractional a => [a]
melodicMinorDesc :: [a]
melodicMinorDesc = [a
0,a
2,a
3,a
5,a
7,a
8,a
10]
melodicMajor :: Fractional a => [a]
melodicMajor :: [a]
melodicMajor = [a
0,a
2,a
4,a
5,a
7,a
8,a
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 = [a
0,a
1,a
3,a
6,a
7,a
8,a
11]
purvi :: Fractional a => [a]
purvi :: [a]
purvi = [a
0,a
1,a
4,a
6,a
7,a
8,a
11]
marva :: Fractional a => [a]
marva :: [a]
marva = [a
0,a
1,a
4,a
6,a
7,a
9,a
11]
bhairav :: Fractional a => [a]
bhairav :: [a]
bhairav = [a
0,a
1,a
4,a
5,a
7,a
8,a
11]
ahirbhairav :: Fractional a => [a]
ahirbhairav :: [a]
ahirbhairav = [a
0,a
1,a
4,a
5,a
7,a
9,a
10]

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

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

-- 8 note scales
diminished :: Fractional a => [a]
diminished :: [a]
diminished = [a
0,a
1,a
3,a
4,a
6,a
7,a
9,a
10]
diminished2 :: Fractional a => [a]
diminished2 :: [a]
diminished2 = [a
0,a
2,a
3,a
5,a
6,a
8,a
9,a
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 = [a
0, a
2, a
3, a
4, a
6, a
7, a
8, a
10, a
11]
messiaen4 :: Fractional a => [a]
messiaen4 :: [a]
messiaen4 = [a
0, a
1, a
2, a
5, a
6, a
7, a
8, a
11]
messiaen5 :: Fractional a => [a]
messiaen5 :: [a]
messiaen5 = [a
0, a
1, a
5, a
6, a
7, a
11]
messiaen6 :: Fractional a => [a]
messiaen6 :: [a]
messiaen6 = [a
0, a
2, a
4, a
5, a
6, a
8, a
10, a
11]
messiaen7 :: Fractional a => [a]
messiaen7 :: [a]
messiaen7 = [a
0, a
1, a
2, a
3, a
5, a
6, a
7, a
8, a
9, a
11]

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

-- 12 note scales
chromatic :: Fractional a => [a]
chromatic :: [a]
chromatic = [a
0,a
1,a
2,a
3,a
4,a
5,a
6,a
7,a
8,a
9,a
10,a
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 [(String, [a])]
table Pattern String
sp Pattern Int
p = (\Int
n String
scaleName
              -> [a] -> Int -> a
forall a. Num a => [a] -> Int -> a
noteInScale ([a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [a
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 t a
s 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 [a]
s 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 (Int
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 = [(String
"minPent", [a]
forall a. Fractional a => [a]
minPent),
              (String
"majPent", [a]
forall a. Fractional a => [a]
majPent),
              (String
"ritusen", [a]
forall a. Fractional a => [a]
ritusen),
              (String
"egyptian", [a]
forall a. Fractional a => [a]
egyptian),
              (String
"kumai", [a]
forall a. Fractional a => [a]
kumai),
              (String
"hirajoshi", [a]
forall a. Fractional a => [a]
hirajoshi),
              (String
"iwato", [a]
forall a. Fractional a => [a]
iwato),
              (String
"chinese", [a]
forall a. Fractional a => [a]
chinese),
              (String
"indian", [a]
forall a. Fractional a => [a]
indian),
              (String
"pelog", [a]
forall a. Fractional a => [a]
pelog),
              (String
"prometheus", [a]
forall a. Fractional a => [a]
prometheus),
              (String
"scriabin", [a]
forall a. Fractional a => [a]
scriabin),
              (String
"gong", [a]
forall a. Fractional a => [a]
gong),
              (String
"shang", [a]
forall a. Fractional a => [a]
shang),
              (String
"jiao", [a]
forall a. Fractional a => [a]
jiao),
              (String
"zhi", [a]
forall a. Fractional a => [a]
zhi),
              (String
"yu", [a]
forall a. Fractional a => [a]
yu),
              (String
"whole", [a]
forall a. Fractional a => [a]
whole'),
              (String
"wholetone", [a]
forall a. Fractional a => [a]
whole'),
              (String
"augmented", [a]
forall a. Fractional a => [a]
augmented),
              (String
"augmented2", [a]
forall a. Fractional a => [a]
augmented2),
              (String
"hexMajor7", [a]
forall a. Fractional a => [a]
hexMajor7),
              (String
"hexDorian", [a]
forall a. Fractional a => [a]
hexDorian),
              (String
"hexPhrygian", [a]
forall a. Fractional a => [a]
hexPhrygian),
              (String
"hexSus", [a]
forall a. Fractional a => [a]
hexSus),
              (String
"hexMajor6", [a]
forall a. Fractional a => [a]
hexMajor6),
              (String
"hexAeolian", [a]
forall a. Fractional a => [a]
hexAeolian),
              (String
"major", [a]
forall a. Fractional a => [a]
major),
              (String
"ionian", [a]
forall a. Fractional a => [a]
ionian),
              (String
"dorian", [a]
forall a. Fractional a => [a]
dorian),
              (String
"phrygian", [a]
forall a. Fractional a => [a]
phrygian),
              (String
"lydian", [a]
forall a. Fractional a => [a]
lydian),
              (String
"mixolydian", [a]
forall a. Fractional a => [a]
mixolydian),
              (String
"aeolian", [a]
forall a. Fractional a => [a]
aeolian),
              (String
"minor", [a]
forall a. Fractional a => [a]
minor),
              (String
"locrian", [a]
forall a. Fractional a => [a]
locrian),
              (String
"harmonicMinor", [a]
forall a. Fractional a => [a]
harmonicMinor),
              (String
"harmonicMajor", [a]
forall a. Fractional a => [a]
harmonicMajor),
              (String
"melodicMinor", [a]
forall a. Fractional a => [a]
melodicMinor),
              (String
"melodicMinorDesc", [a]
forall a. Fractional a => [a]
melodicMinorDesc),
              (String
"melodicMajor", [a]
forall a. Fractional a => [a]
melodicMajor),
              (String
"bartok", [a]
forall a. Fractional a => [a]
bartok),
              (String
"hindu", [a]
forall a. Fractional a => [a]
hindu),
              (String
"todi", [a]
forall a. Fractional a => [a]
todi),
              (String
"purvi", [a]
forall a. Fractional a => [a]
purvi),
              (String
"marva", [a]
forall a. Fractional a => [a]
marva),
              (String
"bhairav", [a]
forall a. Fractional a => [a]
bhairav),
              (String
"ahirbhairav", [a]
forall a. Fractional a => [a]
ahirbhairav),
              (String
"superLocrian", [a]
forall a. Fractional a => [a]
superLocrian),
              (String
"romanianMinor", [a]
forall a. Fractional a => [a]
romanianMinor),
              (String
"hungarianMinor", [a]
forall a. Fractional a => [a]
hungarianMinor),
              (String
"neapolitanMinor", [a]
forall a. Fractional a => [a]
neapolitanMinor),
              (String
"enigmatic", [a]
forall a. Fractional a => [a]
enigmatic),
              (String
"spanish", [a]
forall a. Fractional a => [a]
spanish),
              (String
"leadingWhole", [a]
forall a. Fractional a => [a]
leadingWhole),
              (String
"lydianMinor", [a]
forall a. Fractional a => [a]
lydianMinor),
              (String
"neapolitanMajor", [a]
forall a. Fractional a => [a]
neapolitanMajor),
              (String
"locrianMajor", [a]
forall a. Fractional a => [a]
locrianMajor),
              (String
"diminished", [a]
forall a. Fractional a => [a]
diminished),
              (String
"octatonic", [a]
forall a. Fractional a => [a]
diminished),
              (String
"diminished2", [a]
forall a. Fractional a => [a]
diminished2),
              (String
"octatonic2", [a]
forall a. Fractional a => [a]
diminished2),
              (String
"messiaen1", [a]
forall a. Fractional a => [a]
messiaen1),
              (String
"messiaen2", [a]
forall a. Fractional a => [a]
messiaen2),
              (String
"messiaen3", [a]
forall a. Fractional a => [a]
messiaen3),
              (String
"messiaen4", [a]
forall a. Fractional a => [a]
messiaen4),
              (String
"messiaen5", [a]
forall a. Fractional a => [a]
messiaen5),
              (String
"messiaen6", [a]
forall a. Fractional a => [a]
messiaen6),
              (String
"messiaen7", [a]
forall a. Fractional a => [a]
messiaen7),
              (String
"chromatic", [a]
forall a. Fractional a => [a]
chromatic),
              (String
"bayati", [a]
forall a. Fractional a => [a]
bayati),
              (String
"hijaz", [a]
forall a. Fractional a => [a]
hijaz),
              (String
"sikah", [a]
forall a. Fractional a => [a]
sikah),
              (String
"rast", [a]
forall a. Fractional a => [a]
rast),
              (String
"saba", [a]
forall a. Fractional a => [a]
saba),
              (String
"iraq", [a]
forall a. Fractional a => [a]
iraq)
             ]