diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -3,85 +3,17 @@ ===================================================================== ===================================================================== -=> Build 519 - 2008-05-19 Samuel Silva - * add README - * add LICENSE - -===================================================================== -=> Build 520 - 2008-05-20 Samuel Silva - * absolute on PF style at Melodic and Rhythm - -===================================================================== -=> Build 523 - 2008-05-23 Samuel Silva - * add nocode environment - -===================================================================== -=> Build 527 - 2008-05-27 Samuel Silva - * Rename Confs into Settings - -===================================================================== -=> Build 529 - 2008-05-29 Samuel Silva - * add Motive data type - -===================================================================== -=> Build 602 - 2008-06-02 Samuel Silva - * add changelog - * write wrappers to write musicxml - -===================================================================== -=> Build 603 - 2008-06-03 Samuel Silva - * fix critical bugs at write musicxml - * clean old code - -===================================================================== -=> Build 609 - 2008-06-09 Samuel Silva - * Add Tutorial at doc/Tutorial.lt - * Add Test Suite at Tests/Suite.lhs - * Add Haskore linking - * fix MusicXML bugs at musicxml - -===================================================================== -=> Build 610 - 2008-06-10 Samuel Silva - * Fix bug on attributes at musicxml (already write) - * Fix bug on octave at musicxml (correct value) - -===================================================================== -=> Build 612 - 2008-06-12 Samuel Silva - * Alter Settings definition - -===================================================================== -=> Build 617 - 2008-06-17 Samuel Silva - * add Haskell code generated by DtdToHaskell - -===================================================================== -=> Build 709 - 2008-07-09 Samuel Silva - * add change package definition (Cabal) - -===================================================================== -=> Build 903 - 2008-09-03 Samuel Silva - * rename/move some files - * update package definition with tests +=> Version 0.1 + 2008-11-04 Samuel Silva + * publish package at hackage ===================================================================== -=> Build 1018 - 2008-10-18 Samuel Silva - * rename/move some files +=> Version 0.1.1 + 2008-11-04 Samuel Silva + * fix bug ===================================================================== -=> Build 1022 - 2008-10-22 Samuel Silva - * rename package name to hamusic +=> Version 0.1.2 + 2008-11-04 Samuel Silva + * update minor changes diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -3,28 +3,15 @@ ===================================================================== ===================================================================== -== new TODO - => make representation from Layer1 to Layer3 - => make transformations from Layer3 to our definition - -===================================================================== - -===================================================================== -== Bugs - => Study transposing - transpose C half-tone is C# or Db ? - => Change Accident definition - Doesn't support Natural - -===================================================================== == Features => Print Music (or translate to printable format) => Improve Play Music (or translate to playable format) - => Improve music notation at - Music.Analysis.Notations - => Improve music annotation at - Music.Analysis.Annotation - => New music definition + => Improve translation of music + => Improve counting of music elements + => Improve Abstract Music definition + => Improve MusicXML Stratification definition + => Make MusicGrep tool + => Make Music Scripting language and tools ===================================================================== == Small features @@ -46,13 +33,5 @@ Music.Analysis.Rhythm => Reimplements Rhythm combinators ??? => Clean deprecated code forall modules - -===================================================================== -== Tools - => Write documentation on haddock style - => Write documentation to be processed by lhs2TeX - => Implements more metrics at Metrics.lhs - => "run interactive" doesn't handle - => Implements more Tests at Suite.lhs ===================================================================== diff --git a/hamusic.cabal b/hamusic.cabal --- a/hamusic.cabal +++ b/hamusic.cabal @@ -1,6 +1,6 @@ ------------------------------------------------------------------------------- name: hamusic -version: 0.1.1 +version: 0.1.2 author: Samuel Silva maintainer: Samuel Silva copyright: Copyright (c) 2008 Samuel Silva @@ -92,4 +92,10 @@ extensions: TypeSynonymInstances, FlexibleInstances hs-source-dirs: src main-is: MusicCount.lhs + +executable MusicAnnotate + ghc-options: -Wall + extensions: TypeSynonymInstances, FlexibleInstances + hs-source-dirs: src + main-is: MusicAnnotate.lhs diff --git a/src/HaMusic.lhs b/src/HaMusic.lhs --- a/src/HaMusic.lhs +++ b/src/HaMusic.lhs @@ -23,7 +23,7 @@ warn msg = putStrLn msg >> hFlush stdout -- | version :: String -version = "0.1.1027" +version = "0.1.2" \end{code} \begin{nocode} -- | diff --git a/src/Music/Analysis/ABC.lhs b/src/Music/Analysis/ABC.lhs --- a/src/Music/Analysis/ABC.lhs +++ b/src/Music/Analysis/ABC.lhs @@ -1,19 +1,20 @@ \begin{code} module Music.Analysis.ABC where -import Music.Analysis.Base import Data.List data ABCMusic = ABCMusic ABCMetaData [ABCMusicData] deriving (Eq) data ABCMetaData = ABCMetaData ABCIndex ABCTitle ABCMeter ABCKey + ABCL deriving (Eq) -data ABCIndex = ABCIndex deriving (Eq, Show) -data ABCTitle = ABCTitle deriving (Eq, Show) -data ABCMeter = ABCMeter deriving (Eq, Show) -data ABCKey = ABCKey deriving (Eq, Show) +data ABCIndex = ABCIndex String deriving (Eq) +data ABCTitle = ABCTitle String deriving (Eq) +data ABCMeter = ABCMeter String deriving (Eq) +data ABCKey = ABCKey String deriving (Eq) +data ABCL = ABCL deriving (Eq) data ABCMusicData = Single ABCNote | Tuplet Int [ABCMusicData] @@ -23,6 +24,7 @@ | Staccato ABCMusicData | GraceNotes [ABCNote] ABCMusicData | Symbol String ABCNote + | Bar deriving (Eq) data ABCNote = Pitch Pitch Octave Accident Duration Dotted @@ -33,12 +35,13 @@ deriving (Show, Eq) data Accident = Accident (Maybe Accidental) deriving Eq -data Accidental = Sharp (Number, Int) | Natural | Flat (Number, Int) +data Accidental = Sharp Int | Natural | Flat Int deriving (Eq) data Dotted = Increase Int | Decrease Int deriving (Eq) -type Octave = Int +data Octave = Octave Int + deriving (Eq) data Duration = Duration (Int, Int) deriving (Eq) @@ -47,8 +50,26 @@ \begin{code} instance Show ABCMusic where - show (ABCMusic _ xs) = concat (intersperse " " (map show xs)) + show (ABCMusic x xs) = show x ++ unwords (map show xs) +instance Show ABCMetaData where + show (ABCMetaData a b c d e) = unlines [show a, show b, show c, show e, show d] + +instance Show ABCIndex where + show (ABCIndex x) = "X:" ++ x + +instance Show ABCTitle where + show (ABCTitle t) = "T:" ++ t + +instance Show ABCMeter where + show (ABCMeter m) = "M:" ++ m + +instance Show ABCKey where + show (ABCKey k) = "K:" ++ k + +instance Show ABCL where + show ABCL = "L: 1/4" + instance Show ABCMusicData where show (Single x) = show x show (Tuplet n xs) = "(" ++ show n ++ show xs @@ -58,20 +79,26 @@ show (Staccato x) = "." ++ show x show (GraceNotes xs y) = "{" ++ show xs ++ "}" ++ show y show (Symbol _ y) = show y + show (Bar) = "|\n" instance Show ABCNote where - show (Pitch a b c d e) = show a ++ show b ++ show c ++ show d ++ show e + show (Pitch a b c d e) = show c ++ show a ++ show b ++ show d ++ show e show (Rest True b) = "z" ++ show b show (Rest False b) = "x" ++ show b +instance Show Octave where + show (Octave o) | o > 0 = replicate o '\'' + | o < 0 = replicate o ',' + | otherwise = [] + instance Show Accident where show (Accident (Just x)) = show x show (Accident Nothing) = [] instance Show Accidental where - show (Sharp n) = "^" ++ show n + show (Sharp n) = replicate n '^' show (Natural) = "=" - show (Flat n) = "_" ++ show n + show (Flat n) = replicate n '_' instance Show Dotted where show (Increase n) | n == 0 = [] @@ -80,8 +107,8 @@ | otherwise = "<" ++ show n instance Show Duration where - show (Duration (n,0)) = show n + show (Duration (1,1)) = [] show (Duration (1,n)) = "/" ++ show n - show (Duration (0,n)) = "/" ++ show n + show (Duration (n,1)) = show n show (Duration (x,y)) = show x ++ "/" ++ show y \end{code} diff --git a/src/Music/Analysis/Abstract2ABC.lhs b/src/Music/Analysis/Abstract2ABC.lhs --- a/src/Music/Analysis/Abstract2ABC.lhs +++ b/src/Music/Analysis/Abstract2ABC.lhs @@ -25,11 +25,11 @@ -> ABCMetaData mk_Meta = mk_Meta_aux . p1 . Motive.fromMotive where mk_Meta_aux s = - let a = const ABCIndex s - b = maybe ABCTitle (const ABCTitle) (getText "title" s) - c = maybe ABCMeter (const ABCMeter) (getText "meter" s) - d = maybe ABCKey (const ABCKey) (getText "key" s) - in ABCMetaData a b c d + let a = const (ABCIndex []) s + b = maybe (ABCTitle []) (const (ABCTitle [])) (getText "title" s) + c = maybe (ABCMeter []) (const (ABCMeter [])) (getText "meter" s) + d = maybe (ABCKey []) (const (ABCKey [])) (getText "key" s) + in ABCMetaData a b c d ABC.ABCL -- | mk_Notes :: Motive.Motive (Melodic.MelodicClass, Rhythm.RhythmAbsolute) -> [ABC.ABCMusicData] @@ -40,11 +40,11 @@ let (duration, dotted) = mk_Duration y in case mk_Note' x of Just (pitch, accidental) -> - ABC.Pitch pitch 0 accidental duration dotted + ABC.Pitch pitch (Octave 0) accidental duration dotted Nothing -> ABC.Rest True duration mk_Duration :: Rhythm.RhythmAbsolute -> (ABC.Duration, ABC.Dotted) -mk_Duration (x,y) = (ABC.Duration (denominator x, numerator x), ABC.Increase y) +mk_Duration (x,y) = (ABC.Duration (numerator x, denominator x), ABC.Increase y) mk_Note' :: Melodic.MelodicClass -> Maybe (ABC.Pitch, ABC.Accident) mk_Note' Nothing = Nothing @@ -61,9 +61,9 @@ mk_Accident :: Melodic.Accident -> ABC.Accident mk_Accident Nothing = ABC.Accident Nothing -mk_Accident (Just n) | n > 0 = ABC.Accident (Just (ABC.Sharp (n, 1))) +mk_Accident (Just n) | n > 0 = ABC.Accident (Just (ABC.Sharp (truncate n))) | n == 0 = ABC.Accident (Just (ABC.Natural)) - | n < 0 = ABC.Accident (Just (ABC.Flat (n,1))) + | n < 0 = ABC.Accident (Just (ABC.Flat (truncate n))) | otherwise = ABC.Accident Nothing \end{code} diff --git a/src/Music/Analysis/MusicXML.lhs b/src/Music/Analysis/MusicXML.lhs --- a/src/Music/Analysis/MusicXML.lhs +++ b/src/Music/Analysis/MusicXML.lhs @@ -19,6 +19,9 @@ import qualified Text.XML.MusicXML.Partwise as Partwise import qualified Text.XML.MusicXML.Timewise as Timewise +import Data.Function (on) +import Data.List (groupBy, sortBy) +import Data.Maybe (isJust) import Data.Char (isDigit) import Prelude \end{code} @@ -669,9 +672,11 @@ grd (\x -> null x || not (all isDigit x)) -- | read_IntegerNumber :: String -> Maybe IntegerNumber -read_IntegerNumber = - e2m . (const () -|- read) . - grd (\x -> null x || not (all isDigit x)) +read_IntegerNumber ('-':str) = + ((e2m . (const () -|- negate) . m2e) . read_IntegerNumber) str +read_IntegerNumber str = + (e2m . (const () -|- read) . + grd (\x -> null x || not (all isDigit x))) str -- | coread_Number :: String -> Either Number String coread_Number = @@ -683,3 +688,86 @@ \end{code} +\begin{nocode} +--run :: [MusicXML.Music_Data_] -> [MusicXML.Music_Data_] -> +-- ([MusicXML.Music_Data_],[MusicXML.Music_Data_]) +run [] s = (s,[]) +run ((h@(MusicXML.Music_Data_1 _)):t) s = run t (s++[h]) +run ((h@(MusicXML.Music_Data_2 _)):t) s = run t (s++[h]) +run ((h@(MusicXML.Music_Data_3 _)):t) s = run t (s++[h]) +run (h:t) s = run t (s++[h]) +\end{nocode} + +\begin{nocode} +runOffSet :: MusicXML.Music_Data -> IntegerNumber -> [IntegerNumber] +runOffSet [] = \_ -> [] +--runOffSet ((h@(MusicXML.Music_Data_1 _)):_) = \n -> (n+) (getOffSet h) +--runOffSet ((h@(MusicXML.Music_Data_2 _)):_) = \n -> (n-) (getOffSet h) +--runOffSet ((h@(MusicXML.Music_Data_3 _)):_) = \n -> (n+) (getOffSet h) +runOffSet (h:t) = \n -> (n + getOffSet h) : runOffSet t (n + getOffSet h) +--runOffSet _ = \n -> n + +runOffSet' :: MusicXML.Music_Data -> [IntegerNumber] +runOffSet' = + flip (foldr (\h t -> \n -> (n + getOffSet h) : t (n + getOffSet h)) + (const [])) 0 + +--getIndex :: MusicXML.Music_Data -> [(Int, MusicXML.Music_Data_)] +--getIndex = zip [1..] + +struct :: MusicXML.Music_Data -> [[(Int, MusicXML.Music_Data_)]] +struct = fmap (fmap snd) . + groupBy ((==) `on` fst) . sortBy (compare `on` fst) . + uncurry zip . split (flip runOffSet 0) (zip [1..]) + +\end{nocode} +\begin{code} +-- * Architecture of MusicXML +-- | get offset from music_data elements +getOffSet :: MusicXML.Music_Data_ -> IntegerNumber +getOffSet (MusicXML.Music_Data_1 (_,(x,_,_,_,_,_,_,_,_,_,_,_,_))) = + getOffSet_ x where + getOffSet_ (MusicXML.Note_1 (_,_,_)) = 0 + getOffSet_ (MusicXML.Note_2 (_,(a,_),y)) = + if isJust a then 0 else maybe 0 id (read_IntegerNumber y) + getOffSet_ (MusicXML.Note_3 ((a,_),y,_)) = + if isJust a then 0 else maybe 0 id (read_IntegerNumber y) +getOffSet (MusicXML.Music_Data_2 (x,_)) = maybe 0 negate (read_IntegerNumber x) +getOffSet (MusicXML.Music_Data_3 (x,_,_)) = maybe 0 id (read_IntegerNumber x) +getOffSet _ = 0 +-- | generic sort of Music_Data +arrangeBy :: (Ord b, Num b) => (a -> b) -> [a] -> [[((b,Integer), a)]] +arrangeBy f = fmap (fmap assocl) . + groupBy ((==) `on` p1) . sortBy (compare `on` p1) . + uncurry zip . + split (flip (foldr (\h t -> \n -> (n + f h) : t (n + f h)) + (const [])) 0) + (zip [1..]) +-- | sort of Music_Data +arrange :: MusicXML.Music_Data -> + [[((IntegerNumber, Integer), MusicXML.Music_Data_)]] +arrange = arrangeBy getOffSet +\end{code} + +\begin{nocode} +filepath :: FilePath +--filepath = "E:/estudos/mi-1/dissertacao/svn/work/MusicXML/examples/Recordare/partwise/elite.xml" +--filepath = "E:/estudos/mi-1/dissertacao/svn/work/MusicXML/examples/Recordare/partwise/ActorPreludeSample.xml" +filepath = "E:/estudos/mi-1/dissertacao/svn/work/MusicXML/examples/Recordare/partwise/Binchois.xml" +--filepath = "E:/estudos/mi-1/dissertacao/svn/work/MusicXML/examples/Recordare/partwise/Chant.xml" +ex1, ex2 :: IO () +ex1 = do + x <- MusicXML.read_FILE MusicXML.read_MusicXML_Partwise filepath + case MusicXML.isOK x of + False -> putStrLn ("parsing error at " ++ show filepath) + True -> print ((fmap (fmap (flip runOffSet 0 .snd)) . fmap snd . snd . snd . MusicXML.fromOK) x) +-- True -> print ((fmap (fmap ((\y -> y == sort y) . flip runOffSet 0 .snd)) . fmap snd . snd . snd . MusicXML.fromOK) x) +ex2 = do + x <- MusicXML.read_FILE MusicXML.read_MusicXML_Partwise filepath + case MusicXML.isOK x of + False -> putStrLn ("parsing error at " ++ show filepath) + True -> do let a = ((fmap (fmap (flip runOffSet 0 .snd)) . fmap snd . snd . snd . MusicXML.fromOK) x) + let b = ((fmap (fmap (runOffSet' . snd)) . fmap snd . snd . snd . MusicXML.fromOK) x) + print (a == b) + +\end{nocode} diff --git a/src/Music/Analysis/MusicXML2ABC.lhs b/src/Music/Analysis/MusicXML2ABC.lhs --- a/src/Music/Analysis/MusicXML2ABC.lhs +++ b/src/Music/Analysis/MusicXML2ABC.lhs @@ -5,16 +5,164 @@ -- Portability: portable -- This module implements module Music.Analysis.MusicXML2ABC where +import Music.Analysis.PF import Music.Analysis.MusicXML.Level2 as Level2 +import Music.Analysis.MusicXML.Level1 as Level1 import Music.Analysis.ABC as ABC -import qualified Music.Analysis.Abstract2ABC as Abstract2ABC -import qualified Music.Analysis.MusicXML2Abstract as MusicXML2Abstract +import Data.Ratio + \end{code} \begin{code} +mk_Pitch :: Level1.Step -> ABC.Pitch +mk_Pitch x = case x of + Level1.C -> ABC.C; Level1.D -> ABC.D; + Level1.E -> ABC.E; Level1.F -> ABC.F; + Level1.G -> ABC.G; Level1.A -> ABC.A; Level1.B -> ABC.B; + +mk_Accident :: Maybe Level1.Alter -> Maybe Level2.Accidental -> ABC.Accident +mk_Accident Nothing _ = ABC.Accident Nothing +mk_Accident (Just n) _ | n > 0 = ABC.Accident (Just (ABC.Sharp (truncate n))) + | n < 0 = ABC.Accident (Just (ABC.Flat (truncate n))) + | otherwise = ABC.Accident (Just (ABC.Natural)) + +mk_Duration :: Int -> Level2.Duration -> Maybe Level2.Type -> [Level2.Dot] + -> ABC.Duration +mk_Duration n x _ _ = +-- let d = duration (x%n, (length ly) % 1) + let d = duration (x%n, (0::Int) % 1) + in Duration (numerator d, denominator d) + where duration = hyloL + (maybe 0 (uncurry (+))) + (e2m . (const () -|- split p1 ((/2) >< pred)) . grd ((<=0).p2)) . + (id >< succ) +-- where pred x = x - 1 +-- succ x = x + 1 + +mk_Octave :: Level1.Octave -> ABC.Octave +mk_Octave o = Octave (o - 4) + +mk_Dotted :: [Level1.Dot] -> ABC.Dotted +mk_Dotted _ = ABC.Increase 0 + +mk_Note :: Int -> Level2.Note -> ABC.ABCNote +mk_Note n (Level2.Note_3 (Level2.Full_Note_1 (ax,ay,az),a2),b,c,d) = + ABC.Pitch (mk_Pitch ax) (mk_Octave az) (mk_Accident ay d) + (mk_Duration n a2 b c) (mk_Dotted c) +mk_Note n (Level2.Note_3 (Level2.Full_Note_3 _,a2),b,c,_) = + ABC.Rest True (mk_Duration n a2 b c) + mk_Music :: Level2.Score_Partwise -> ABC.ABCMusic -mk_Music = Abstract2ABC.mk_Music . MusicXML2Abstract.mk_Music -\end{code} +-- Motive (Melodic.MelodicClass, Rhythm.RhythmAbsolute) +-- [(Melodic.MelodicClass, Rhythm.RhythmAbsolute)] +mk_Music musicxml = + ABC.ABCMusic (mk_MetaData musicxml) (mk_MusicDatas 1 musicxml) +-- ((mk_MusicData 1) (concat musicxml)) +mk_MusicDatas :: Int -> [[Level2.Music_Data]] -> [ABC.ABCMusicData] +--mk_MusicDatas musicxml = --((mk_MusicData 1) (concat musicxml)) +mk_MusicDatas _ [] = [] +mk_MusicDatas n (x:xs) = + let n' = get_Divisions_MusicData x + in mk_MusicData n x ++ ABC.Bar : mk_MusicDatas (maybe n id n') xs + +-- (foldr (\a b -> let (x,y) = mk_MusicData 1 a in y ++ ABC.Bar : y) [] musicxml) +-- (foldr (\a b -> mk_MusicData 1 a ++ ABC.Bar : b) [] musicxml) --(mk_MusicData 1) (concat musicxml)) +mk_MetaData :: Level2.Score_Partwise -> ABC.ABCMetaData +mk_MetaData s = ABC.ABCMetaData (ABC.ABCIndex "1") (mk_Title s) + (get_Meter_MusicData (concat s)) + (get_Key_MusicData (concat s)) + ABC.ABCL + +mk_Title :: Level2.Score_Partwise -> ABC.ABCTitle +mk_Title _ = ABC.ABCTitle "no title" + +mk_Meter :: Level2.Time -> ABC.ABCMeter +mk_Meter (Level2.Time_5 l) = (ABC.ABCMeter . unwords) + (map (\((a,b),c) -> maybe "" (\y -> show y ++ "+") b ++ + show a ++ "/" ++ show c) l) + +get_Meter_MusicData :: [Level2.Music_Data] -> ABC.ABCMeter +get_Meter_MusicData = foldr + (\a b -> case a of;Level2.Music_Data_5 x -> get_Meter x;_ -> b) (ABC.ABCMeter "C") + +get_Meter :: Level2.Attributes -> ABC.ABCMeter +get_Meter (_,_,[],_) = ABC.ABCMeter "C" +get_Meter (_,_,(x:_),_) = mk_Meter x + +get_Key_MusicData :: [Level2.Music_Data] -> ABC.ABCKey +get_Key_MusicData = foldr + (\a b -> case a of;Level2.Music_Data_5 x -> get_Key x;_ -> b) (ABC.ABCKey "MusicDataC") + +get_Key :: Level2.Attributes -> ABC.ABCKey +get_Key (_,[],_,_) = ABC.ABCKey "C" +get_Key (_,((Key_1 (a,b),_):_),_,_) = + ABC.ABCKey (get_KeyN (a + (maybe 0 get_Key_adjust b)) ++ maybe [] get_Key_1b b) +--ABC.ABCKey (show a ++ maybe [] get_Key_1b b) +get_Key (_,((Key_2 [],_):_),_,_) = ABC.ABCKey "Key2" +get_Key (_,((Key_2 ((a,b):_),_):_),_,_) = ABC.ABCKey (show a ++ show b) + +get_KeyN :: Int -> String +get_KeyN (-8) = "Fb" +get_KeyN (-7) = "Cb" +get_KeyN (-6) = "Gb" +get_KeyN (-5) = "Db" +get_KeyN (-4) = "Ab" +get_KeyN (-3) = "Eb" +get_KeyN (-2) = "Bb" +get_KeyN (-1) = "F" +get_KeyN 0 = "C" +get_KeyN 1 = "G" +get_KeyN 2 = "D" +get_KeyN 3 = "A" +get_KeyN 4 = "E" +get_KeyN 5 = "B" +get_KeyN 6 = "F#" +get_KeyN 7 = "C#" +get_KeyN 8 = "G#" +get_KeyN 9 = "D#" +get_KeyN 10 = "A#" +get_KeyN 11 = "E#" +get_KeyN 12 = "B#" +get_KeyN _ = "KeyN" + +get_Key_1b :: Level2.Mode -> String +get_Key_1b (Major) = "" +get_Key_1b (Minor) = "m" +get_Key_1b m = take 3 (show m) + +get_Key_adjust :: Level2.Mode -> Int +get_Key_adjust Major = 0 +get_Key_adjust Minor = 3 +get_Key_adjust Ionian = 0 +get_Key_adjust Aeolian = 3 +get_Key_adjust Mixolydian = 1 +get_Key_adjust Dorian = 2 +get_Key_adjust Phrygian = 4 +get_Key_adjust Lydian = (-1) +get_Key_adjust Locrian = (-2) + +--mk_MusicData :: [Level2.Music_Data] -> +-- [(Melodic.MelodicClass, Rhythm.RhythmAbsolute)] +mk_MusicData :: Int -> [Level2.Music_Data] -> [ABC.ABCMusicData] +mk_MusicData _ [] = [] +mk_MusicData n ((Level2.Music_Data_1 x):xs) = + (ABC.Single (mk_Note n x)) : (mk_MusicData n xs) +mk_MusicData n ((Level2.Music_Data_5 x):xs) = + let n' = (maybe n id (get_Divisions x)) in mk_MusicData n' xs + +-- map (ABC.Single . mk_Note) +-- map mk_Note . map (\(Level2.Music_Data_1 x) -> x) . filter p +-- where p (Level2.Music_Data_1 _) = True +-- p _ = False + +get_Divisions :: Level2.Attributes -> Maybe Int +get_Divisions (Nothing,_,_,_) = Nothing +get_Divisions (Just n,_,_,_) = Just (n) + +get_Divisions_MusicData :: [Level2.Music_Data] -> Maybe Int +get_Divisions_MusicData = foldr + (\a b -> case a of;Level2.Music_Data_5 x -> get_Divisions x;_ -> b) Nothing +\end{code} diff --git a/src/MusicAnnotate.lhs b/src/MusicAnnotate.lhs new file mode 100644 --- /dev/null +++ b/src/MusicAnnotate.lhs @@ -0,0 +1,102 @@ +\begin{code} +-- | +-- Maintainer : silva.samuel@alumni.uminho.pt +-- Stability : experimental +-- Portability: portable +-- This module implements +module Main where +import qualified Text.XML.MusicXML as MusicXML +--import Music.Analysis.MusicXML2Haskore +--import Music.Analysis.MusicXML.Functions +import Control.Monad +import Data.List +import System.IO +import System.Environment +import System.Console.GetOpt + +\end{code} + +\begin{code} +-- | +warn :: String -> IO () +warn msg = putStrLn msg >> hFlush stdout +-- | +version :: String +version = "0.1.2" +\end{code} + +\begin{code} +-- | +data Option = Unknown +-- | MusicXML | Abstract | ABC | Lilypond | Haskore +-- | Format +-- | MusicXML2Abstract +-- | Abstract2ABC +-- | Abstract2Lilypond +-- | MusicXML2Haskore + | Help + | Version + deriving (Eq, Show) + +-- | +options :: [OptDescr Option] +options = [ + Option ['v','V'] ["version"] (NoArg Version) "show version number" + , Option ['h','H','?'] ["help"] (NoArg Help) "show help" + + ] + +-- | +header :: String -> String +header prog = "Usage: "++ prog ++" [OPTIONS...] FILES..." +\end{code} + +\begin{code} +--Nothing Nothing +importMusicXML :: FilePath -> IO (Maybe MusicXML.MusicXMLDoc) +importMusicXML input = do + musicxml <- MusicXML.read_FILE MusicXML.read_MusicXMLDoc input + case MusicXML.isOK musicxml of + True -> return (Just (MusicXML.fromOK musicxml)) + False -> putStrLn ("Can't read "++show input) >> return Nothing + +\end{code} + +\begin{code} +main :: IO () +main = do + argv <- getArgs + prog <- getProgName + case getOpt Permute options argv of + (o,n,[]) | Help`elem`o -> putStrLn (usageInfo (header prog) options) + | Version`elem`o -> putStrLn (unwords [prog, version]) + | otherwise -> mapM_ (\input -> do importMusicXML input) n + (_,_,errs) -> putStrLn (unlines errs ++ usageInfo (header prog) options) +\end{code} + +\begin{nocode} +-- | +main :: IO () +main = do + argv <- getArgs + prog <- getProgName + curdir <- getCurrentDirectory + case getOpt Permute options' argv of + (o,n,[]) | Help'`elem`o -> putStrLn (usageInfo (header prog) options') + | Version'`elem`o -> putStrLn (unwords [prog, version]) + | Check`elem`o -> + mapM_ (maybe (return ()) + (either (procScriptFile True) setCurrentDirectory) . + parseOptions) (o ++ map Input' n) + >> setCurrentDirectory curdir + | otherwise -> + mapM_ (maybe (return ()) + (either (procScriptFile False) setCurrentDirectory) . + parseOptions) (o ++ map Input' n) + >> setCurrentDirectory curdir + (_,_,errs) -> putStrLn (unlines errs ++ usageInfo (header prog) options') +\end{nocode} + + + + diff --git a/src/MusicCount.lhs b/src/MusicCount.lhs --- a/src/MusicCount.lhs +++ b/src/MusicCount.lhs @@ -23,7 +23,7 @@ warn msg = putStrLn msg >> hFlush stdout -- | version :: String -version = "0.1.1027" +version = "0.1.2" \end{code} \begin{code} diff --git a/src/MusicTranslate.lhs b/src/MusicTranslate.lhs --- a/src/MusicTranslate.lhs +++ b/src/MusicTranslate.lhs @@ -20,7 +20,6 @@ import System.Environment import System.Console.GetOpt import System.FilePath -import Control.Exception (throw, Exception(..)) \end{code} \begin{code} @@ -29,7 +28,7 @@ warn msg = putStrLn msg >> hFlush stdout -- | version :: String -version = "0.1.1028" +version = "0.1.2" \end{code} \begin{code} @@ -39,7 +38,7 @@ | Help | Version deriving (Eq, Show) -data Format = MusicXML | Abstract | ABC | Lilypond | Haskore | Unknown +data Format = MusicXML | Abstract | ABC | Lilypond | Haskore | Unknown String deriving (Eq, Show) -- | isInput :: Option -> Bool @@ -55,7 +54,7 @@ importFormat "abc" = ABC importFormat "lilypond" = Lilypond importFormat "haskore" = Haskore -importFormat _ = Unknown +importFormat str = Unknown str -- | options :: [OptDescr Option] @@ -77,7 +76,7 @@ -- | fromError :: MusicXML.Result a -> String fromError (MusicXML.Error e) = e -fromError (MusicXML.Ok _) = throw (ErrorCall "internal error") +fromError (MusicXML.Ok _) = error "internal error" -- | forFILES :: [x] -> (x -> IO ()) -> IO () forFILES xs f = mapM_ f xs @@ -175,10 +174,10 @@ convert Lilypond Haskore xs = do let _ = map (flip replaceExtension "hs") xs todo Lilypond Haskore -convert a b _ | a == b = todo a b - | a == Unknown = todo a b - | b == Unknown = todo a b - | otherwise = todo a b +convert (a@(Unknown _)) b _ = todo a b +convert a (b@(Unknown _)) _ = todo a b +convert a b _ | a == b = todo a b + | otherwise = todo a b \end{code}