module Music.Theory.Tuning.Scala.Mode where
import Data.Char
import Data.List
import Data.Maybe
import qualified Music.Theory.Function as T
import qualified Music.Theory.List as T
import qualified Music.Theory.Tuning.Scala as T
type MODE = (Int,[Int],String)
mode_starting_degree :: MODE -> Int
mode_starting_degree (d,_,_) = d
mode_intervals :: MODE -> [Int]
mode_intervals (_,i,_) = i
mode_description :: MODE -> String
mode_description (_,_,d) = d
mode_degree :: MODE -> Int
mode_degree = sum . mode_intervals
type MODENAM = (Int,Int,[MODE])
modenam_modes :: MODENAM -> [MODE]
modenam_modes (_,_,m) = m
modenam_search_seq :: MODENAM -> [Int] -> [MODE]
modenam_search_seq (_,_,m) x = filter ((== x) . mode_intervals) m
modenam_search_seq1 :: MODENAM -> [Int] -> Maybe MODE
modenam_search_seq1 mn = T.unlist1 . modenam_search_seq mn
modenam_search_description :: MODENAM -> String -> [MODE]
modenam_search_description (_,_,m) x = filter (isInfixOf x . mode_description) m
mode_stat :: MODE -> [String]
mode_stat (d,i,s) =
["mode-start-degree : " ++ show d
,"mode-intervals : " ++ intercalate "," (map show i)
,"mode-degree : " ++ show (sum i)
,"mode-description : " ++ s]
non_implicit_degree :: String -> Maybe Int
non_implicit_degree s =
case T.unbracket s of
Just ('[',s',']') -> Just (read s')
_ -> Nothing
is_non_implicit_degree :: String -> Bool
is_non_implicit_degree = isJust . non_implicit_degree
is_integer :: String -> Bool
is_integer = all isDigit
parse_modenam_entry :: [String] -> MODE
parse_modenam_entry w =
let (n0:n,c) = span (T.predicate_or is_non_implicit_degree is_integer) w
in case non_implicit_degree n0 of
Nothing -> (0,map read (n0:n),unwords c)
Just d -> (d,map read n,unwords c)
join_long_lines :: [String] -> [String]
join_long_lines l =
case l of
p:q:l' -> case T.separate_last' p of
(p',Just '\\') -> join_long_lines ((p' ++ q) : l')
_ -> p : join_long_lines (q : l')
_ -> l
parse_modenam :: [String] -> MODENAM
parse_modenam l =
case l of
n:x:m -> let n' = read n :: Int
x' = read x :: Int
m' = map (parse_modenam_entry . words) m
in if n' == length m' then (n',x',m') else error "parse_modenam"
_ -> error "parse_modenam"
load_modenam :: IO MODENAM
load_modenam = do
l <- T.load_dist_file "modenam.par"
return (parse_modenam (T.filter_comments (join_long_lines l)))