module Temporal.Music.Scales
(
ji3, ji5, ji7,
pyth,
hindGb,
hindFs,
justBP,
partchean,
luScale,
superJust, harmonicJust,
sruti,
eqt, eqts, eqBP, hind,
minor5, major5,
bluesMinor5, bluesMajor5, egyptian5,
major, minor,
ionian, dorian, phrygian, lydian,
mixolydian, aeolian, locrian)
where
import Temporal.Music.Pitch(Hz, Interval,
Scale(..), scaleLength, fromIntervals)
import qualified Data.Vector as V
sliceScale :: Int -> [Int] -> Scale -> Scale
sliceScale octaveLength ids x
| octaveLength == (V.length $ scaleSteps x) =
Scale (scaleBase x) (scaleOctave x) $
V.fromList $ map (scaleSteps x V.! ) ids
| otherwise = error
("scale must have " ++ show octaveLength ++
" tones in octave")
minor5 = slice12 minor5Is
major5 = slice12 major5Is
egyptian5 = slice12 egyptian5Is
bluesMinor5 = slice12 bluesMinor5Is
bluesMajor5 = slice12 bluesMajor5Is
major5Is = pentaIs
egyptian5Is = rot 1 $ pentaIs
bluesMinor5Is = rot 2 $ pentaIs
bluesMajor5Is = rot 3 $ pentaIs
minor5Is = rot 4 $ pentaIs
pentaIs = [2, 2, 3, 2, 2]
major, minor,
ionian, dorian, phrygian, lydian,
mixolydian, aeolian, locrian :: Scale -> Scale
major = slice12 majorIs
minor = slice12 minorIs
ionian = slice12 ionianIs
dorian = slice12 dorianIs
phrygian = slice12 phrygianIs
lydian = slice12 lydianIs
mixolydian = slice12 mixolydianIs
aeolian = slice12 aeolianIs
locrian = slice12 locrianIs
majorIs = [2, 2, 1, 2, 2, 2, 1]
minorIs = aeolianIs
ionianIs = rot 0 majorIs
dorianIs = rot 1 majorIs
phrygianIs = rot 2 majorIs
lydianIs = rot 3 majorIs
mixolydianIs = rot 4 majorIs
aeolianIs = rot 5 majorIs
locrianIs = rot 7 majorIs
slice12 :: [Int] -> (Scale -> Scale)
slice12 ids = sliceScale 12 (fromIs ids)
fromIs = (0:) . fst . foldl f ([], 0) . init
where f (res, i) x = (res ++ [i + x], i + x)
rot :: Int -> [a] -> [a]
rot n xs = drop n xs ++ take n xs
eqt :: Hz -> Scale
eqt = fromIntervals 2 (map ((2 **) . (/12)) [0 .. 11])
eqts :: Hz -> Scale
eqts = res
where n = scaleLength $ res 0
res = fromIntervals 2 $
(map ((2 **) . (/fromIntegral n) . fromIntegral) [0 .. n1])
hind :: Hz -> Scale
hind = hindemitheanGen $ 0.5 * (ji5 (1, 2, 1) + ji5 (2, 2, 1))
eqBP :: Hz -> Scale
eqBP = fromIntervals 3 (map ((3 **) . (/13) . fromIntegral) [0 .. 12])
pyth :: Hz -> Scale
pyth = fromIntervals 2 $ map toPyth
[(0, 0), (5, 3), (2, 1), (3, 2), (4, 2), (1, 1),
(6, 4), (1, 0), (4, 3), (3, 1), (2, 2), (5, 2)]
toPyth :: (Int, Int) -> Interval
toPyth (a, b) = ji3 (b, a)
ji3 :: (Int, Int) -> Interval
ji3 (a, b) = (2 ^^ a) * (1.5 ^^ b)
ji5 :: (Int, Int, Int) -> Interval
ji5 (a, b, c) = (2 ^^ a) * (1.5 ^^ b) * (1.25 ^^ c)
hindFs :: Hz -> Scale
hindFs = hindemitheanGen $ ji5 (1, 2, 1)
hindGb :: Hz -> Scale
hindGb = hindemitheanGen $ ji5 (2, 2, 1)
hindemitheanGen :: Interval -> Hz -> Scale
hindemitheanGen tritone = fromIntervals 2 $ map ji5
[(0, 0, 0), (1, 1, 1), (1, 2, 0), (0, 1, 1), (0, 0, 1), (1, 1, 0)]
++ [tritone] ++ map ji5
[(0, 1, 0), (1, 0, 1), (1, 1, 1), (2, 2, 0), (0, 1, 1)]
ji7 :: (Int, Int, Int, Int) -> Interval
ji7 (a, b, c, d) = (2 ^^ a) * (1.5 ^^ b) * (1.25 ^^ c) * ((7/6) ^^ d)
justBP :: Hz -> Scale
justBP = fromIntervals 3
[1, 27/25, 25/21, 9/7,
7/5, 75/49, 5/3, 9/5,
49/25, 15/7, 7/3, 63/25,
25/9]
partchean :: Hz -> Scale
partchean = fromIntervals 2
[1, 81/80, 33/32, 21/20, 16/15,
12/11, 11/10, 10/9, 9/8, 8/7,
7/6, 32/27, 6/5, 11/9, 5/4,
14/11, 9/7, 21/16, 4/3, 27/20,
11/8, 7/5, 10/7, 16/11, 40/27,
3/2, 32/21, 14/9, 11/7, 8/5,
18/11, 5/3, 27/16, 12/7, 7/4,
16/9, 9/5, 20/11, 11/6, 15/8,
40/21, 64/33, 160/81]
luScale :: Hz -> Scale
luScale = fromIntervals 2
[1, 18/17, 9/8, 6/5, 54/43,
4/3, 27/19, 3/2, 27/17, 27/16,
9/5, 36/19]
superJust :: Hz -> Scale
superJust = fromIntervals 2
[1, 17/16, 9/8, 6/5, 5/4,
4/3, 11/8, 3/2, 13/8, 5/3,
7/4, 15/8]
harmonicJust :: Hz -> Scale
harmonicJust = fromIntervals 2
[1, 17/16, 9/8, 19/16, 5/4,
21/16, 11/8, 3/2, 13/8, 27/16,
7/4, 15/8]
sruti :: Hz -> Scale
sruti = fromIntervals 2
[1, 256/243, 16/15, 10/9, 9/8,
32/27, 6/5, 5/4, 81/64, 4/3,
27/20, 45/32, 729/512, 3/2, 128/81,
8/5, 5/3, 27/16, 16/9, 9/5,
15/8, 243/128]