{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where import Data.List import Control.Monad import Text.Printf import Data.Function(on) divisor :: Int -> Int -> Bool divisor a b = mod a b == 0 isPrime :: Int -> Bool isPrime 1 = True isPrime 2 = True isPrime n = all (\x -> not $ divisor n x) [2..(n-1)] primes :: [Int] primes = filter isPrime [1..] normalize :: (Int,Int) -> (Int,Int) normalize (a,b) | divisor == 1 = (a,b) | otherwise = normalize (div a divisor, div b divisor) where divisor = gcd a b tones primelimit factorlimit = nub $ (takeWhile (<= primelimit) primes) ++ [1..factorlimit] intervals :: [Int] -> [(Int,Int)] intervals tones = uniqs where intervals = (1,16) : [ (a,b) | a <- tones, b <- tones, a <= b, b >= a*2] uniqs = nub $ map normalize intervals justintervals :: [Interval] justintervals = [(1,1), (16,15), (10,9), (9,8), (8,7), (7,6), (6,5), (5,4), (9,7), (4,3), (7,5), (10,7), (3,2), (14,9), (8,5), (5,3), (12,7), (7,4), (16,9), (9,5), (15,8), (2,1) ] justintervals2 :: [Interval] justintervals2 = [(1,1), (16,15), (10,9), (9,8), (7,6), (6,5), (5,4), (4,3), (7,5), (10,7), (3,2), (8,5), (5,3), (7,4), (9,5), (15,8), (2,1), (9,4), (12,5), (5,2), (8,3), (14,5), (3,1), (16,9) ] -- substitution: 12/7 is preferable to 7/4, as it's the inversion of 7/6 -- likewise, 16/9 is preferable to 9/5, as 9/8 is used more than 10/9 telescale :: [Interval] telescale = [(1,1), (16,15), (10,9), (9,8), (7,6), (6,5), (5,4), (4,3), (7,5), (10,7), (3,2), (8,5), (5,3), (7,4), (16,9), (15,8), (2,1), (9,4), (12,5), (5,2), (8,3), (14,5), (3,1)] simplescale :: [Interval] simplescale = [(1,1), (16,15), (10,9), (9,8), (7,6), (6,5), (5,4), (4,3), {- (7,5), (10,7), -} (45,32), (64,45), (3,2), (8,5), (5,3), (16,9), (15,8), (2,1), (32,15), (9,4), (12,5), (5,2), (8,3), (3,1), (16,5), (10,3)] {- aug_telescale :: [Interval] aug_telescale = sort ((135,128):telescale) -} bassscale :: [Interval] bassscale = [(1,1), (16,15), (10,9), (9,8), (7,6), (6,5), (5,4), (4,3), (45,32), (64,45), (3,2), (8,5), (5,3), (12,7), (16,9), (9,5), (15,8), (2,1), (32,15), (9,4), (12,5), (5,2), (8,3), (3,1), (16,5), (10,3), (32,9), (15,4), (4,1)] fivelimitscale :: [Interval] fivelimitscale = [(1,1), (16,15), (10,9), (9,8), (75,64), (6,5), (5,4), (4,3), (45,32), (64,45), (3,2), (8,5), (5,3), (128,75), (16,9), (9,5), (15,8), (2,1), (32,15), (9,4), (12,5), (5,2), (8,3), (3,1), (16,5), (10,3), (32,9), (15,4), (4,1), (27,20), (40,27), (81,64), (135,128)] fivelimitscalebolds = [0, 17, 28] sevenlimitscale :: [Interval] = [(1,1), (16,15), (10,9), (9,8), (8,7), (7,6), (6,5), (5,4), (4,3), (9,7), (7,5), (45,32), (64,45), (10,7), (14,9), (3,2), (8,5), (5,3), (12,7), (7,4), (16,9), (9,5), (15,8), (2,1), (32,15), (9,4), (12,5), (5,2), (8,3), (3,1), (16,5), (10,3), (32,9), (15,4), (4,1), (27,20), (40,27), (81,64), (135,128), (25,24), (48,25)] mattsscale :: [Interval] = [(1,1), (16,15), (10,9), (9,8), (7,6), (6,5), (5,4), (4,3), (45,32), (64,45), (3,2), (8,5), (5,3), (12,7), (16,9), (9,5), (15,8), (2,1), (32,15), (9,4), (12,5), (5,2), (8,3), (3,1), (16,5), (10,3), (32,9), (15,4), (4,1)] keyboard24 :: [Interval] = [(1,1), -- 0 (16,15), -- 1 (10,9), -- 2 (9,8), -- 3 (8,7), -- 4 (7,6), -- 5 (6,5), -- 6 (5,4), -- 7 (9,7), -- 8 (4,3), -- 9 (7,5), -- 10 (45,32), -- 11 (1,1), -- 12 (64,45), -- 13 (10, 7), -- 14 (3,2), -- 15 (14,9), -- 16 (8,5), -- 17 (5,3), -- 18 (12,7), -- 19 (7,4), -- 20 (16,9), -- 21 (9,5), -- 22 (15,8) -- 23 {- (2,1) -- 24 -} ] stick :: [Interval] = sortBy compareIval $ [(1,1), --(17,16), (135,128), (16,15), (10,9), (9,8), (7,6), (6,5), (5,4), (45,32), --(64,45), (17,12), (4,3), (3,2), (5,3), (27,16), (8,5), (7,4), (16,9), (9,5), (15,8), (2,1), (11,8), (14,9), (13,8), (32,15), (9,4), (12,5), (5,2), (8,3), (3,1), (10,3), (16,5), (32,9), (15,4), (4,1) ] fifths :: [Interval] = sortBy compareIval $ [(1,1), (16,15), (10,9), (6,5), (5,4), (4,3), (64,45), (40,27), {- (27,20), (45,32), (3,2), (8,5), (5,3), -} (9,5), (15,8), (2,1), (27,16), (32,27) ] fifths2 :: [Interval] = sortBy compareIval $ [(1,1), (16,15), (10,9), (9,8), (7,6), (14,9), (32,27), --(320,243), (6,5), (5,4), (81,64), (405,256), (4,3), (64,45), (45,32), (40,27), (3,2), (5,3), (8,5), (16,9), (9,5), (15,8), --(81,64), (2,1), (32,15), (20,9), (5,2), (8,3), (80,27), --(44,27), --(13,9), --(13,12), (12,5), --(19,8), (28,27), (112,81), (27,20), (56,27), (88,27), (96,27), (64,27), (27,16) ] fourths :: [Interval] = sortBy compareIval $ [(1,1), (16,15), (10,9), (9,8), --(7,6), --(14,9), (32,27), --(320,243), (6,5), (5,4), (81,64), (405,256), (4,3), (64,45), (45,32), (40,27), (3,2), (5,3), (8,5), (16,9), (9,5), (15,8), --(81,64), (2,1), (32,15), (20,9), (5,2), (8,3), (80,27), --(44,27), --(13,9), --(13,12), (12,5), --(19,8), --(28,27), --(112,81), (27,20), --(56,27), --(88,27), (96,27), (64,27), (27,16) ] xv300 = map (\x -> (x, (fretpos x) * 626)) simplescale johnston :: [Interval] = [(x, 16) | x <- [16..32]] chapman_strings :: [Interval] chapman_strings = [ (16,9), (4,3), (1,1), (3,4), (9,16), (27,64), (2,9), (1,3), (1,2), (3,4), (9,8), (27,16) ] {- just16 = sort $ [ (5,9), (5,6), (5,4), (15,8), (45,16), (4,9), (2,3), (1,1), (3,2), (9,4), (27,8), (8,15), (4,5), (6,5), (5,9), (27,10)] -} just16 :: [Interval] just16 = [(1,1),(16,15),(10,9),(9,8),(6,5),(5,4),(4,3),(27,20),(45,32),(3,2),(8,5),(5,3),(27,16),(16,9),(9,5),(15,8),(2,1)] dadgad :: [Interval] dadgad = [(1,2), (3,4), (1,1), (4,3), (3,2), (2,1)] eadgbe :: [Interval] eadgbe = [(9,16), (3,4), (1,1), (4,3), (9,5), (9,4)] fretpos :: Interval -> Float fretpos (a_,b_) = let a = fromIntegral a_ b = fromIntegral b_ in 1-(b/a) intervalsort :: [Interval] -> [Interval] intervalsort = sortBy (compare `on` fretpos) frets :: [Int] -> [Float] frets = sort . (map fretpos) . intervals td' (a,b) = "