module Music.Theory.Wyschnegradsky where
import Data.Char
import Data.List
import Data.Maybe
import qualified Data.List.Split as Split
import qualified Music.Theory.List as List
import qualified Music.Theory.Pitch as Pitch
import qualified Music.Theory.Pitch.Spelling.Table as Spelling
normalise_step :: (Eq n,Num n) => n -> n -> n
normalise_step :: forall n. (Eq n, Num n) => n -> n -> n
normalise_step n
m n
n
| n
n forall a. Eq a => a -> a -> Bool
== n
1 = n
1
| n
n forall a. Eq a => a -> a -> Bool
== -n
1 = -n
1
| n
n forall a. Eq a => a -> a -> Bool
== n
m forall a. Num a => a -> a -> a
- n
1 = -n
1
| n
n forall a. Eq a => a -> a -> Bool
== n
1 forall a. Num a => a -> a -> a
- n
m = n
1
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"normalise_step"
parse_num_sign :: (Num n, Read n) => String -> n
parse_num_sign :: forall n. (Num n, Read n) => String -> n
parse_num_sign String
s =
case forall a. [a] -> ([a], a)
List.separate_last String
s of
(String
n,Char
'+') -> forall a. Read a => String -> a
read String
n
(String
n,Char
'-') -> forall a. Num a => a -> a
negate (forall a. Read a => String -> a
read String
n)
(String, Char)
_ -> forall a. HasCallStack => String -> a
error String
"parse_num_sign"
vec_expand :: Num n => Int -> [n]
vec_expand :: forall n. Num n => Int -> [n]
vec_expand Int
n = if Int
n forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. Int -> a -> [a]
replicate Int
n n
1 else forall a. Int -> a -> [a]
replicate (forall a. Num a => a -> a
abs Int
n) (-n
1)
parse_vec :: Num n => Maybe Int -> n -> String -> [n]
parse_vec :: forall n. Num n => Maybe Int -> n -> String -> [n]
parse_vec Maybe Int
n n
m =
let f :: [n] -> [n]
f = case Maybe Int
n of
Just Int
i -> forall a. Num a => a -> [a] -> [a]
List.dx_d n
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
cycle
Maybe Int
Nothing -> forall a. Num a => a -> [a] -> [a]
List.dx_d n
m
in forall a. Int -> [a] -> [a]
List.dropRight Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [n] -> [n]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall n. Num n => Int -> [n]
vec_expand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. (Num n, Read n) => String -> n
parse_num_sign) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
Split.splitOn String
","
add_m :: Integral a => a -> a -> a -> a
add_m :: forall a. Integral a => a -> a -> a -> a
add_m a
n a
p a
q = (a
p forall a. Num a => a -> a -> a
+ a
q) forall a. Integral a => a -> a -> a
`mod` a
n
parse_hex_clr :: (Read n,Num n) => String -> (n,n,n)
parse_hex_clr :: forall n. (Read n, Num n) => String -> (n, n, n)
parse_hex_clr String
clr =
let f :: Char -> Char -> a
f Char
p Char
q = forall a. Read a => String -> a
read (String
"0x" forall a. [a] -> [a] -> [a]
++ [Char
p,Char
q])
in case String
clr of
[Char
'#',Char
p,Char
q,Char
r,Char
s,Char
t,Char
u] -> (forall {a}. Read a => Char -> Char -> a
f Char
p Char
q,forall {a}. Read a => Char -> Char -> a
f Char
r Char
s,forall {a}. Read a => Char -> Char -> a
f Char
t Char
u)
String
_ -> forall a. HasCallStack => String -> a
error String
"parse_hex"
parse_hex_clr_int :: String -> (Int,Int,Int)
parse_hex_clr_int :: String -> (Int, Int, Int)
parse_hex_clr_int = forall n. (Read n, Num n) => String -> (n, n, n)
parse_hex_clr
clr_normalise :: (Real r,Fractional f) => f -> (r,r,r) -> (f,f,f)
clr_normalise :: forall r f. (Real r, Fractional f) => f -> (r, r, r) -> (f, f, f)
clr_normalise f
m (r
r,r
g,r
b) = let f :: a -> f
f a
x = forall a b. (Real a, Fractional b) => a -> b
realToFrac a
x forall a. Fractional a => a -> a -> a
/ f
m in (forall {a}. Real a => a -> f
f r
r,forall {a}. Real a => a -> f
f r
g,forall {a}. Real a => a -> f
f r
b)
data Seq a = Radial [a] | Circumferential [a]
seq_group :: Int -> Int -> Seq a -> [[a]]
seq_group :: forall a. Int -> Int -> Seq a -> [[a]]
seq_group Int
c_div Int
r_div Seq a
s =
case Seq a
s of
Circumferential [a]
c -> forall e. Int -> [e] -> [[e]]
Split.chunksOf Int
c_div [a]
c
Radial [a]
r -> forall a. [[a]] -> [[a]]
transpose (forall e. Int -> [e] -> [[e]]
Split.chunksOf Int
r_div [a]
r)
iw_pc_pp :: Integral n => String -> [[n]] -> IO ()
iw_pc_pp :: forall n. Integral n => String -> [[n]] -> IO ()
iw_pc_pp String
sep =
let f :: n -> String
f = (Bool, Bool) -> Pitch -> String
Pitch.pitch_pp_opt (Bool
False,Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Integral i => Spelling i -> Octave_PitchClass i -> Pitch
Pitch.octpc_to_pitch forall i. Integral i => Spelling i
Spelling.pc_spell_ks forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) n
4
in String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate String
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map n -> String
f)
u3_ix_ch :: Integral i => i -> Char
u3_ix_ch :: forall i. Integral i => i -> Char
u3_ix_ch = forall i a. Integral i => [a] -> i -> a
genericIndex String
"ROYGBV" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`mod` i
6)
u3_ch_ix :: Char -> Int
u3_ch_ix :: Char -> Int
u3_ch_ix = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"u3_ch_ix") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
"ROYGBV"
u3_vec_text_iw :: [(String, String)]
u3_vec_text_iw :: [(String, String)]
u3_vec_text_iw =
[(String
"4+,4-,4+,4-,2+"
,String
"4-,4+,4-,4+,4-,4+,4-,4+,4-")
,(String
"9+,2+,2-,2+,2-,2+"
,String
"2+,2-,2+,2-,2+,2-,2+,2-,2+,18+")
,(String
"12-,12+,12-"
,String
"18+,18-")
,(String
"3+,3-,3+,3-,3+,3-"
,String
"18+,18-")
,(String
"9+,9-"
,String
"3+,3-,3+,3-,3+,3-,3+,3-,3+,3-,3+,3-")
,(String
"2+,2-,2+,2-,2+,2-"
,String
"6-,6+,6-,6+,6-,6+")
,(String
"2+,2-,2+,2-,2+,2-"
,String
"6+,6-,6+,6-,6+,6-")
,(String
"6+,6-"
,String
"2+,2-,2+,2-,2+,2-,2+,2-,2+,2-,2+,2-,2+,2-,2+,2-,2+,2-")]
u3_vec_text_rw :: [(String, String)]
u3_vec_text_rw :: [(String, String)]
u3_vec_text_rw =
[(String
"4+,3-,5+,3-,3+"
,String
"4-,3+,5-,3+,5-,3+,5-,3+,5-")
,(String
"9+,2+,1-,3+,1-,2+"
,String
"2+,1-,3+,1-,3+,1-,3+,1-,3+,1-,3+,1-,3+,1-,3+,1-,3+,2-")
,(String
"12-,12+,12-"
,String
"18+,18-")
,(String
"3+,2-,4+,2-,4+,3-"
,String
"18+,18-")
,(String
"9+,9-"
,String
"3+,2-,4+,1-,1+,1-,3+,1-,1+,1-,3+,2-,4+,1-,1+,1-,3+,1-,1+,1-")
,(String
"2+,1-,3+,1-,3+,2-"
,String
"6-,6+,6-,6+,6-,6+")
,(String
"2+,1-,3+,1-,3+,2-"
,String
"6+,6-,6+,6-,6+,6-")
,(String
"6+,6-"
,String
"2+,1-,3+,1-,3+,1-,3+,1-,3+,1-,3+,1-,3+,1-,3+,1-,3+,2-")]
u3_vec_ix :: Num n => ([[n]],[[n]])
u3_vec_ix :: forall n. Num n => ([[n]], [[n]])
u3_vec_ix =
let f :: (String, String) -> [[n]]
f (String
p,String
q) = [forall n. Num n => Maybe Int -> n -> String -> [n]
parse_vec forall a. Maybe a
Nothing n
0 String
p,forall n. Num n => Maybe Int -> n -> String -> [n]
parse_vec forall a. Maybe a
Nothing n
0 String
q]
([[n]]
c,[[n]]
r) = forall t. [t] -> (t, t)
List.firstSecond (forall a. [[a]] -> [[a]]
transpose (forall a b. (a -> b) -> [a] -> [b]
map forall {n}. Num n => (String, String) -> [[n]]
f [(String, String)]
u3_vec_text_rw))
in ([[n]]
c,[[n]]
r)
u3_ix_radial :: Integral n => [[n]]
u3_ix_radial :: forall n. Integral n => [[n]]
u3_ix_radial =
let ([[n]]
c,[[n]]
r) = forall n. Num n => ([[n]], [[n]])
u3_vec_ix
r' :: [[[n]]]
r' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Int -> a -> [a]
replicate (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[n]]
c) [[n]]
r
in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> a -> a -> a
add_m n
6) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[n]]
c) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[n]]]
r')
u3_clr_nm :: [String]
u3_clr_nm :: [String]
u3_clr_nm = String -> [String]
words String
"red orange yellow green blue violet"
u3_clr_hex :: [String]
u3_clr_hex :: [String]
u3_clr_hex = String -> [String]
words String
"#e14630 #e06e30 #e2c48e #498b43 #2a5a64 #cb7b74"
u3_clr_rgb :: Fractional n => [(n,n,n)]
u3_clr_rgb :: forall n. Fractional n => [(n, n, n)]
u3_clr_rgb = forall a b. (a -> b) -> [a] -> [b]
map (forall r f. (Real r, Fractional f) => f -> (r, r, r) -> (f, f, f)
clr_normalise n
256 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Int, Int, Int)
parse_hex_clr_int) [String]
u3_clr_hex
u3_radial_ch :: [(Int,[Char])]
u3_radial_ch :: [(Int, String)]
u3_radial_ch =
[(Int
1,String
"RVBGY GBV BGYOR OYG YORVB VRO RVBGY GBVBGYO")
,(Int
5,String
"ROYG YO YGBV BV BVRO RO ROYG YO YGBV BV BVR OR O")]
u3_circ_ch :: [(Int,[Char])]
u3_circ_ch :: [(Int, String)]
u3_circ_ch =
[(Int
6,String
"ROYOYGBGBVRV")
,(Int
7,String
"ROYOYGBGBVRV")
,(Int
8,String
"ROYGBVRVBGYO")]
u3_ch_seq_to_vec :: [Char] -> [Int]
u3_ch_seq_to_vec :: String -> [Int]
u3_ch_seq_to_vec =
forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (forall n. (Eq n, Num n) => n -> n -> n
normalise_step Int
6) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Num a => [a] -> [a]
List.d_dx forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
u3_ch_ix forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
dc9_circ :: Num n => [[n]]
dc9_circ :: forall n. Num n => [[n]]
dc9_circ =
[[n
6,n
5,n
4,n
3,n
2]
,[n
3,n
2,n
1,n
0,n
11,n
10]
,[n
11,n
10,n
9,n
8,n
7,n
6,n
5]
,[n
6,n
5]
,[n
6,n
5,n
4]
,[n
5,n
4,n
3,n
2]
,[n
3,n
2,n
1,n
0]
,[n
1,n
0,n
11]
,[n
0,n
11]
,[n
0,n
1,n
2,n
3,n
4,n
5,n
6]
,[n
5,n
6,n
7,n
8,n
9,n
10,n
9]
,[n
10,n
11,n
0,n
1]
,[n
0,n
1,n
2,n
3]
,[n
2,n
3,n
4]
,[n
3,n
4]
,[n
3,n
4]
,[n
3,n
4,n
5]
,[n
4,n
5,n
6,n
7]]
dc9_rad :: Num n => [n]
dc9_rad :: forall n. Num n => [n]
dc9_rad = [n
0,n
10,n
8,n
6,n
4,n
2,n
0,n
10,n
8,n
6,n
4,n
2,n
0,n
10,n
8,n
6,n
4,n
2]
dc9_ix :: Integral n => [[n]]
dc9_ix :: forall n. Integral n => [[n]]
dc9_ix = forall a b. (a -> b) -> [a] -> [b]
map (\n
n -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. Integral a => a -> a -> a -> a
add_m n
12 n
n) forall n. Num n => [n]
dc9_rad) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall n. Num n => [[n]]
dc9_circ)
dc9_clr_hex :: [String]
dc9_clr_hex :: [String]
dc9_clr_hex =
let c :: [String]
c = [String
"#e96d61",String
"#e6572b"
,String
"#e07122",String
"#e39e36"
,String
"#e8b623",String
"#e5c928"
,String
"#c2ba3d",String
"#a2a367"
,String
"#537a77",String
"#203342"
,String
"#84525e",String
"#bc6460"]
n :: [Int]
n = forall a. [a] -> [a] -> [a]
List.interleave [Int
6,Int
4,Int
2,Int
0,Int
10,Int
8] [Int
5,Int
3,Int
1,Int
11,Int
9,Int
7] :: [Int]
in forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall a. Ord a => [a] -> [a]
sort (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
n [String]
c))
dc9_clr_rgb :: Fractional n => [(n,n,n)]
dc9_clr_rgb :: forall n. Fractional n => [(n, n, n)]
dc9_clr_rgb = forall a b. (a -> b) -> [a] -> [b]
map (forall r f. (Real r, Fractional f) => f -> (r, r, r) -> (f, f, f)
clr_normalise n
255 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Int, Int, Int)
parse_hex_clr_int) [String]
dc9_clr_hex
u11_circ :: Num n => [[n]]
u11_circ :: forall n. Num n => [[n]]
u11_circ =
[[n
7,n
8,n
9,n
10,n
11,n
0,n
1,n
2,n
3]
,[n
10,n
11,n
0,n
1,n
2,n
3,n
4,n
5,n
6]
,[n
0,n
1,n
2,n
3,n
4,n
5]
,[n
0,n
1,n
2]
,[n
10,n
11]
,[n
6,n
7]
,[n
2]
,[n
9]
,[n
4]
,[n
11]
,[n
6,n
7]
,[n
2]
,[n
9]
,[n
2]
,[n
11]
,[n
6,n
7]
,[n
2,n
3]
,[n
10,n
11,n
0]
,[n
7,n
8,n
9,n
10,n
11,n
0]
,[n
7,n
8,n
9,n
10,n
11,n
0,n
1,n
2,n
3]
,[n
10,n
11,n
0,n
1,n
2,n
3,n
4,n
5,n
6]]
u11_gen_seq :: Integral i => i -> Int -> [i] -> [i]
u11_gen_seq :: forall i. Integral i => i -> Int -> [i] -> [i]
u11_gen_seq i
z Int
n = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Integral a => a -> a -> a
`mod` i
12) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> [a] -> [a]
List.dx_d i
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
cycle
u11_seq_rule :: Integral i => Maybe Int -> [i]
u11_seq_rule :: forall i. Integral i => Maybe Int -> [i]
u11_seq_rule Maybe Int
n = forall i. Integral i => i -> Int -> [i] -> [i]
u11_gen_seq i
0 Int
18 (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [-i
1] (\Int
x -> forall a. Int -> a -> [a]
replicate Int
x (-i
1) forall a. [a] -> [a] -> [a]
++ [i
5]) Maybe Int
n)
ull_rad_text :: [Char]
ull_rad_text :: String
ull_rad_text =
let x :: String
x = String
"012588----"
y :: String
y = String
"-"
in String
x forall a. [a] -> [a] -> [a]
++ String
y forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse String
x
u11_rad :: Integral n => [[n]]
u11_rad :: forall n. Integral n => [[n]]
u11_rad =
let f :: Char -> Maybe a
f Char
c = if Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall a. Read a => String -> a
read [Char
c])
in forall a b. (a -> b) -> [a] -> [b]
map (forall i. Integral i => Maybe Int -> [i]
u11_seq_rule forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Read a => Char -> Maybe a
f) String
ull_rad_text
u11_clr_hex :: [String]
u11_clr_hex :: [String]
u11_clr_hex =
let c :: [String]
c = [String
"#dbb56a",String
"#ffb05c",String
"#ea7c3f",String
"#f93829",String
"#ee6054",String
"#d18d9c"
,String
"#a94c79",String
"#215272",String
"#628b7d",String
"#9dbc90",String
"#ecdfaa",String
"#fbeaa5"]
n :: [Int]
n = forall a. [a] -> [a]
reverse ([Int
4..Int
11] forall a. [a] -> [a] -> [a]
++ [Int
0..Int
3]) :: [Int]
in forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall a. Ord a => [a] -> [a]
sort (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
n [String]
c))
u11_clr_rgb :: Fractional n => [(n,n,n)]
u11_clr_rgb :: forall n. Fractional n => [(n, n, n)]
u11_clr_rgb = forall a b. (a -> b) -> [a] -> [b]
map (forall r f. (Real r, Fractional f) => f -> (r, r, r) -> (f, f, f)
clr_normalise n
256 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Int, Int, Int)
parse_hex_clr_int) [String]
u11_clr_hex