-- not used. The parsepitch function works. module MelodyParser (parsemelody, melodyElementP) where import Control.Monad import Text.ParserCombinators.Parsec import qualified Data.Char as Char import qualified Data.List as List import qualified Melody import qualified Harmony import qualified Midi import Data.Ratio pitch::Parser Rational pitch = do base <- diatonicpitch accidentals <- many accidental return (List.foldl' (*) base accidentals) makelettertorationalparser::[(Char,Rational)]->Parser Rational makelettertorationalparser table = choice (map mkchoice table) where mkchoice (letter,pitch) = char letter >> return pitch diatonicpitch::Parser Rational diatonicpitch = makelettertorationalparser (octave ++ (map (\(c,p)->(Char.toLower c,2*p)) octave)) where octave = [('C',1%1) ,('D',9%8) ,('E',81%64) ,('F',4%3) ,('G',3%2) ,('A',27%16) ,('B',243%128) ] accidental::Parser Rational accidental = makelettertorationalparser [('\'',2%1) ,(',',1%2) ,('#',2187%2048) ,('b',2048%2187) ,('+',81%80) ,('-',80%81) ,('7',63%64) ,('L',64%63) ,('^',33%32) ,('v',32%33) ] "Accidental or octave marker" rest = char 'z' >> return Melody.Rest note = do p <- pitch return (Melody.Note p 64) durationmodifier::Parser Rational durationmodifier = choice [do char '*' factor <- option 2 number return (factor%1) ,do char '/' factor <- option 2 number return (1%factor) ] where number = liftM read (liftM2 (:) (oneOf "123456789") (many digit)) duration :: Parser Rational duration = do modifiers <- many durationmodifier return (List.foldl' (*) (1%1) modifiers) melodyElementP = do n <- rest <|> note d <- duration return (d,n) melody = liftM Melody.Melody $ many (do e <- melodyElementP; many whitespace; return e) melodyeof = between (many whitespace) (many whitespace >> eof) melody whitespace = oneOf " \t\r\n|" "whitespace" parsemelody::String -> Either String (Melody.Melody Rational Rational) parsemelody input = case runParser melodyeof () "Melody string" input of Left exception -> Left (show exception) Right result -> Right result unright (Right r) = r -- | | | testsong = [(0,48,0x10, "c d c B- c e- g bb7 a- f c f g*3 . ") ,(1,48,0x30, "G Bb7 G*4 C E- F- A-*2 c e-*3 . ") ,(2,48,0x50, "E-*4 C*2 G, C C*3 A- G*3 . ") ,(3,48,0x70, "C*2 C*2 G,*4 F,*4 C*3 . ") ] test = writeFile "test.mid" $ Midi.tofile 240 $ Harmony.tomidi 240 . Harmony.Harmony $ map (\(a,b,c,d)->(a,b,c,unright . parsemelody $ d)) testsong -- Alla som tror att dom vet nanting ljuger testsong2 = [(0,48,0x10, allaS++santS) ,(1,48,0x58, allaA++santA) ,(2,48,0xc8, allaT++santT) ,(3,48,0xf0, allaB++santB) ] where allaS = "g a/ f#-/ g d/ d/ a d/ d/ d' b-/ ./" allaA = "d d/ d/ e- B-/ c7/ d c7/ c7/ d B-/ ./" allaT = "B- A/ A/ G F#-/ F#-/ A F#-/ A/ G G/ ./" allaB = "G D/ D/ C D/ D/ D D/ D/ G, G,/ ./" -- santS = "g b-/ a/ g g/ f7/ e- d/ f#-/ g . " santA = "d d/ d/ e- d/ d/ c B-/ d/ d . " santT = "G G/ G/ G B-/ A/ G G/ A/ B- . " santB = "G, G,/ G,/ C G,/ G,/ C G,/ D/ G . " test2 = writeFile "test.mid" $ Midi.tofile 240 $ Harmony.tomidi 240 . Harmony.Harmony $ map (\(a,b,c,d)->(a,b,c,unright . parsemelody $ d)) testsong2 testsong3 = [(0,48,0x20, "a*4 b- c'*5 b- a*4 . " ++ "a*2 g#- f#*9 g#- a*2 .") ,(1,48,0x60, "c#- d*5 e- f e- d*5 c#- . " ++ "c#- B*5 A#- G# A#- B*5 c#- .") ,(2,48,0xc0, "E*2 F#- G*9 F#- E*2 . " ++ "E*4 D#- C#*5 D#- E*4 .") ,(3,48,0xE0, "A,*4 B,- C*5 B,- A,*4 . " ++ "A,*2 G,# F,#*9 G,#- A,*2 .") ] test3 = writeFile "test.mid" $ Midi.tofile 240 $ Harmony.tomidi 240 . Harmony.Harmony $ map (\(a,b,c,d)->(a,b,c,unright . parsemelody $ d)) testsong3 testsong4 = [(0,48,0x20, hongS++yawnS++bringsS++breezeS) ,(1,48,0x30, hongA++yawnA++bringsA++breezeA) ,(2,48,0x50, hongT++yawnT++bringsT++breezeT) ,(3,48,0x60, hongB++yawnB++bringsB++breezeB) ] where hongS = ". . . . g ab+ g . " hongA = ". . . . g ab+ g . " hongT = "G Ab+ G . . . . . " hongB = "G, G, G, . . . . . " yawnS = "d' b- a/ g/ g" yawnA = ". g/ g/ f#-/ d/ d" yawnT = "./ d/ c^ B-/ A/ B-" yawnB = "G,/ D/ D/ G,/ G, ." bringsS = "./ a/ b-/ c'^/ b-/ a/ a " bringsA = "g/ f#-/ g/ f#-/ f#-/ d/ d " bringsT = "A G/ A/ A/ G/ F#- " bringsB = "D D/ D/ D/ B,-/ A, " breezeS = "b-*2 . a/ g/ g/ g/ g/ g/ g*3/ ./" breezeA = "g*2 . d/ d/ d/ d/ d/ d/ d*3/ ./" breezeT = "D*2 . F#-/ G/ G/ G/ G/ G/ G*3/ ./" breezeB = "G,*2 . G,/ G,/ G,/ G,/ G,/ G,/ G,*3/ ./" test4 = writeFile "test.mid" $ Midi.tofile 120 $ Harmony.tomidi 240 . Harmony.Harmony $ map (\(a,b,c,d)->(a,b,c,unright . parsemelody $ d)) testsong4 testsong5 = [(0,48,0x20, "a- a-*2 bb7/ bb7/ a-*3/ a-/ a- a- a-*3/ a-/ bb c' d'- c' c' c' c'*3 bb a-* g* a-*3 .") ,(1,48,0x30, "f f*2 e-/ e-/ f*3/ f/ e- e- f#--*3/ f#--/ g- a- bb bb/ a-/ g g a-*3 f f* f e- f*3 .") ,(2,48,0x50, "c c*2 c/ c/ a-*3/ d-/ d- c#-- d-*3/ d-/ d- f f f f e- f*3 d- d-* c* c*3 .") ,(3,48,0x60, "F F*2 C/ C/ D-*3/ D-/ E- E- D-*3/ D-/ G- F Bb c c c F*3 B,b D-* C* F,*3 .") ] test5 = writeFile "test.mid" $ Midi.tofile 70 $ Harmony.tomidi 120 . Harmony.Harmony $ map (\(a,b,c,d)->(a,b,c,unright . parsemelody $ d)) testsong5