4 # Copyright (C) 2003 Rainer Typke
5 #pae2xml is licensed under the terms of the GNU General Public License Version
6 #2 as published by the <a href="http://www.fsf.org/" target="_top">Free Software Foundation</a>.
7 #This gives you legal permission to copy, distribute and/or modify <em>pae2xml</em> under
8 #certain conditions. Read
9 #the <a href="http://www.gnu.org/copyleft/gpl.html" target="_top">online version of the license</a>
10 #for more details. pae2xml is provided AS IS with NO WARRANTY OF ANY KIND,
11 #INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY, AND FITNESS FOR A PARTICULAR PURPOSE.
16 $old_duration = $divisions;
19 ($mday, $mon, $year) = (localtime()) [3..5];
20 $encoding_date = sprintf("%4d-%02d-%02d", $year + 1900, $mon+1, $mday);
27 $p =~ s/\s*\=\=+\s*(.*?)\s*\=\=+\s*/$1/sg;
28 $p =~ s/\s*included.*?-------------*\s*(.*?)\s*/$1/s;
31 if ($q !~ /^.*1\.1\.1.*$/gsx && $r =~ /^.*plain.*$/gsx) {
32 print_error
("$a contains 'plain', but not 1.1.1!\n");
34 if ($p =~ /^\s*([^\n]+)\n(.*?)\n((\d+\.\d+\.\d.*?plain.*?\n)+)(.*?)\n?([^\n]+)\n([^\n]+)\s*$/gs) {
35 my ($comp, $title, $incipits, $sonst, $libsig, $rismsig) = ($1, $2, $3, $5, $6, $7);
43 RISM SIGN.: $rismsig\n\n";
44 parse_incipits
($incipits, $comp, $title, $sonst, $libsig, $rismsig);
47 if (index($p,"plain&easy") > -1) {
48 print_error
("Ignoring the following text:\n\n\n$p\n\n\n");
57 my ($incipits, $comp, $title, $sonst, $libsig, $rismsig) = @_;
59 $toprint .= "parsing: $incipits\n";
61 while ($incipits =~ /^(\d+\.\d+\..+?)(\d+\.\d+\..*)$/gs) {
64 parse_pe
($inc1, $comp, $title, $sonst, $libsig, $rismsig);
66 parse_pe
($incipits, $comp, $title, $sonst, $libsig, $rismsig);
70 my ($pe, $comp, $title, $sonst, $libsig, $rismsig) = @_;
72 $pe =~ s/@ü/@0ü/gs; # make missing time signature explicit
73 while ($pe =~ s/([^\-])(\d+)(\'|\,)(A|B|C|D|E|F|G)/$1$3$2$4/gs) {}; # octave first, then duration. Truly global.
75 if ($pe =~ /^\s*(\d+\.\d+\.\d)(\.|:)\s*(.*?)\nplain&easy:\s*(%([\w\-\d]+))?(@([\d\w\/]+))?\s
*&?\s
*(\
$([^ü
]+))?ü
(.*)$/gs
) {
76 my ($inr, $instr, $clef, $timesig, $keysig, $rest) = ($1, $3, $5, $7, $9, $10);
78 my $filename="$rismsig-$inr.xml";
79 $filename =~ s/RISM\s*A\/II\s*:?\s*//gs
;
80 print "Writing $filename...\n";
82 open(OUT
, ">$filename");
84 if ($clef =~ /^(\w)\-(\d)$/) {
85 ($clefsign, $clefline) = ($1, $2);
87 ($clefsign, $clefline) = ("G", 2);
90 $timesig = timesignature
($timesig);
92 my %fif=("", 0, "xF", 1, "xFC", 2, "xFCG",3, "xFCGD",4, "xFCGDA",5, "xFCGDAE",6, "xFCGDAEB",7, "bB",-1, "bBE",-2, "bBEA",-3, "bBEAD",-4, "bBEADG",-5, "bBEADGC",-6, "bBEADGCF",-7);
93 $keysig =~ s/(\s+)|&//gs; # it is unclear what the & means, so we'll ignore it for now.
94 $keysig =~ s/\[|\]//gs; # IGNORING brackets around a key sig.
95 $fifths = $fif{$keysig};
96 if ($fifths eq "") { $fifths = "0";
97 print_error
("Strange key signature '$keysig'.\n");}
99 foreach $_ ($rismsig,$title,$inr,$instr,$comp,$encoding_date,$libsig,$sonst)
104 print OUT
'<?xml version="1.0" encoding="iso-8859-1" standalone="no"?>
105 <!DOCTYPE score-partwise PUBLIC "-//Recordare//DTD MusicXML 0.6 Partwise//EN" "file:/c:/Program Files/MusicXML/partwise.dtd">
108 <work-number>'.$rismsig.'</work-number>
109 <work-title>'.$title.'</work-title>
111 <movement-number>'.$inr.'</movement-number>
112 <movement-title>'.$instr.'</movement-title>
114 <creator type="composer">'.$comp.'</creator>
116 <software>pae2xml by R. Typke</software>
117 <encoding-date>'.$encoding_date.'</encoding-date>
119 <source>'.$libsig.'</source>
123 <part-name>'.$sonst.'</part-name>
129 <divisions>'.$divisions.'</divisions>
131 <fifths>'.$fifths.'</fifths>
135 <sign>'.$clefsign.'</sign>
136 <line>'.$clefline.'</line>
149 parse_notes
($rest, $keysig);
151 else { print_error
("could not parse $pe\n"); }
153 </score-partwise>\n";
157 # Repeat $1 by a count of $2
159 (my $e, my $count) = @_;
161 for (my $i=1; $i <= $count; ++$i)
169 my ($notes, $keysig) = @_;
170 my $qq = 0; # in group of cue notes
172 my $meas = 2; # measure number
173 my $mopen = 1; # measure tag still open
175 if ($notes =~ /^\s*(.*?)\s*$/) {
179 $notes =~ s/!([^!]*)!(f*)/repeat($1, length($2)+1)/gse; # write out repetitions
180 $notes =~ s/\{([^\}]*)\}/$1/gs; # ignore beamings
181 while ( $notes =~ s/(:?\/+:?|^)([^\/:]*)(:?\
/+:?)i(:?\/+:?
)/$1$2$3$2$4/gs) {}; # replace whole-measure repeats (i notation)
183 $notes =~ s/(\d+)\(([^;]+\))/\($1$2/gs; # pull note lengths into fermatas or triplets
184 $notes =~ s/(xx|x|bb|b|n)\(/\($1/gs; # pull accidentals into tuplets or fermatas:
185 $notes =~ s/(\d+)(xx|x|bb|b|n)(A|B|C|D|E|F|G)/$2$1$3/gs; # accidentals first, then duration
187 # $notes =~ s/x\(/\(x/gs; # pull accidentals into tuplets or fermatas
188 # $notes =~ s/bb\(/\(bb/gs; # pull accidentals into tuplets or fermatas
189 # $notes =~ s/b\(/\(b/gs; # pull accidentals into tuplets or fermatas
190 # $notes =~ s/n\(/\(n/gs; # pull accidentals into tuplets or fermatas
191 # $notes =~ s/(\'+|\,+)\(/\($1/g; # pull octave marks into tuplets or fermatas
193 $notes =~ s/(\.|\d|\,|\')qq/qq$1/gs; # pull beginning mark of group of grace notes in front of corresponding notes
194 $notes =~ s/(xx|x|bb|b|n)qq/qq$1/gs; # qq first, then parts of notes
196 while ($notes ne "") {
197 if ($notes =~ /^(\'+|\,+)(.*)$/) { # Octave marks
198 ($oct, $notes) = ($1, $2);
200 } elsif ($notes =~ /^qq(.*)$/) { # Begin grace
203 } elsif ($notes =~ /^r(.*)$/) { # End grace
206 } elsif ($notes =~ /^\=(\d*)(\/.*)$/) { # multi-measure rests
209 if ($measrest eq '') {
212 $toprint .= "$measrest measures of rest.\n";
214 # Create a real multi-bar rest
215 print OUT
' <attributes>
217 <multiple-rest>'.$measrest.'</multiple-rest>
222 # Now create the measures
223 for $n (1..$measrest) {
226 <duration>'.($beats*$divisions*4/$beattype).'</duration
>
227 '.# <type>quarter</type>
231 if ($n < $measrest) {
232 print OUT " </measure>\n";
234 print OUT ' <measure number
="'.$meas.'">
242 } elsif ($notes =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)$/) { # a note
243 ($note, $notes) = ($1,$6);
244 parse_note($note, $keysig, "", "", $qq);
245 } elsif ($notes =~ /^(\((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?\))(.*)$/) { # one note with a fermata
246 ($note, $notes) = ($1,$6);
247 parse_note($note, $keysig, "", "", $qq);
248 } elsif ($notes =~ /^(\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?){3}\))(.*)$/) { # a triplet
249 ($triplet, $notes) = ($1,$7);
250 # print "TRIPLET: ".$triplet." -> ";
251 $triplet =~ /^\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)\)$/gs;
252 ($note, $triplet) = ($1,$6);
253 #print "$note $triplet\n";
254 parse_note($note, $keysig, '<tuplet type
="start"/>', ' <time-modification
>
255 <actual
-notes
>3</actual
-notes
>
256 <normal
-notes
>2</normal
-notes
>
257 </time-modification
>', $qq);
258 $triplet =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)$/gs;
259 ($note, $triplet) = ($1,$6);
260 #print "$note $triplet\n";
261 parse_note($note, $keysig, '', ' <time-modification
>
262 <actual
-notes
>3</actual
-notes
>
263 <normal
-notes
>2</normal
-notes
>
264 </time-modification
>', $qq);
265 parse_note($triplet, $keysig, '<tuplet type
="stop"/>', ' <time-modification
>
266 <actual
-notes
>3</actual
-notes
>
267 <normal
-notes
>2</normal
-notes
>
268 </time-modification
>', $qq);
269 } elsif ($notes =~ /^((\d+)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)+\;(\d+)\))(.*)$/) { # an n-tuplet
270 ($tuplet, $notes) = ($1,$9);
271 # print "N-TUPLET: ".$tuplet." -> ";
272 $tuplet =~ /^(\d+)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*);(\d)\)$/gs;
273 ($combdur, $note, $tuplet, $numval) = ($1,$2,$7,$8);
274 #print "i=$combdur, n=$numval; $note / $tuplet\n";
275 my $ind_dur = duration($combdur)/$numval;
277 my $act_notes = $numval;
278 parse_note($note, $keysig, '<tuplet type
="start"/>', ' <time-modification
>
279 <actual
-notes
>'.$act_notes.'</actual
-notes
>
280 <normal
-notes
>1</normal
-notes
>
281 </time-modification
>', $qq);
282 while ($tuplet =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.+)$/gs) {
283 ($note, $tuplet) = ($1,$6);
284 #print "$note / $tuplet\n";
285 parse_note($note, $keysig, '', ' <time-modification
>
286 <actual
-notes
>'.$act_notes.'</actual
-notes
>
287 <normal
-notes
>1</normal
-notes
>
288 </time-modification
>', $qq);
290 parse_note($tuplet, $keysig, '<tuplet type
="stop"/>', ' <time-modification
>
291 <actual
-notes
>'.$act_notes.'</actual
-notes
>
292 <normal
-notes
>1</normal
-notes
>
293 </time-modification
>', $qq);
294 } elsif ($notes =~ /^(%\w-\d)(.*)$/) { # Clef change
295 ($clef,$notes) = ($1,$2);
296 $clef =~ /^%(\w)\-(\d)$/;
297 ($clefsign, $clefline) = ($1, $2);
298 print OUT ' <attributes
>
300 <sign
>'.$clefsign.'</sign
>
301 <line
>'.$clefline.'</line
>
305 } elsif ($notes =~ /^@(\d\/\d|c\/?)\s*(.*)$/) { # time signatue change
307 ($timesig,$notes) = ($1,$2);
308 #print "-> $timesig / $notes\n"; exit;
309 $timesig = timesignature($timesig);
310 print OUT " <attributes>\n$timesig
312 } elsif ($notes =~ /^(:?\/+:?)(.*)$/) { # Barline (and repeats)
315 if ($barline =~ /^:\/\/:/) {
316 print OUT ' <barline location
="right">
317 <bar
-style
>light
-light
</bar
-style
>
318 <repeat direction
="backward"/>
321 } elsif ($barline =~ /^:\/\/$/ ) {
322 print OUT ' <barline location
="right">
323 <bar
-style
>light
-heavy
</bar
-style
>
324 <repeat direction
="backward"/>
327 } elsif ($barline =~ /^\/\/$/) {
328 print OUT ' <barline location
="right">
329 <bar
-style
>light
-light
</bar
-style
>
330 <repeat direction
="backward"/>
334 print OUT " </measure>\n";
336 print OUT ' <measure number
="'.$meas.'">
338 if ($barline =~ /^\/\/:$/) {
339 print OUT ' <barline location
="left">
340 <bar
-style
>heavy
-light
</bar
-style
>
341 <repeat direction
="forward"/>
344 } elsif ($barline =~ /^:\/\/:$/) {
345 print OUT ' <barline location
="left">
346 <repeat direction
="forward"/>
355 $toprint .= "bar line\n";
356 } #elsif ($notes =~ /^(\d*\.*\-)(.*)$/) {
357 #($rst, $notes) = ($1, $2);
358 #$toprint .= "rest: $rst\n";
359 #$rst =~ /^(\d*)(\.*)\-$/;
360 #($rst, $dots) =($1,$2);
363 # <duration>'.duration($rst, $dots).'</duration>
364 #'.# <type>quarter</type>
368 elsif ($notes =~ /^\((\=)\)(.*)$/) { # a bar of rest with a fermata
369 ($rst, $notes) = ($1, $2);
370 $toprint .= "rest: $rst\n";
373 <duration>'.($beats*$divisions*4/$beattype).'</duration
>
374 '.# <type>quarter</type>
376 <fermata type
="upright"/>
381 elsif ($notes =~ s/(\d+\.*)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)\)/\($1$2\)/gs) { # pull duration into fermata parentheses
382 # print "after replacement: $notes\n"; exit;
385 print_error("got stuck with $notes\n");
390 print OUT " </measure>\n";
396 my($note, $keysig, $notation, $addition, $in_qq_group) = @_;
399 my ($actualnotes, $normalnotes) = (1,1);
401 if ($addition =~ /^\s*<time-modification>\s*<actual-notes>\s*(\d+)\s*<\/actual-notes>\s*<normal-notes>\s*(\d+)\s*<\/normal-notes>\s*<\/time-modification>\s*$/) {
402 ($actualnotes, $normalnotes) = ($1, $2);
405 if ($note =~ /^\((.*)\)$/) {
410 $note =~ /^((\,|\')*)(x|xx|b|bb|n)?(\d*)(\.*)(g|q)?(\-|A|B|C|D|E|F|G)(t?)(\+?)$/;
411 my ($oct, $acc, $dur, $dot, $gracecue, $pitch, $trill, $tie) = ($1, $3, $4, $5, $6, $7, $8, $9);
415 if ($gracecue eq "g") {
416 print OUT ' <grace steal
-time-following
="33"/>
419 if ($gracecue eq "q" || $in_qq_group) {
424 print OUT " <rest />\n";
427 <step
>'.$pitch.'</step
>
429 alter($pitch, $acc, $keysig).'
430 <octave
>'.octave($oct).'</octave
>
434 if ($gracecue ne "g") {
435 print OUT ' <duration
>'.(duration($dur, $dot)*$normalnotes/$actualnotes).'</duration
>
438 # <type>quarter</type>
443 print OUT '<tie type
="start"/>
448 print OUT '<tie type
="stop"/>
456 my $notationbracket = $fermata || ($trill eq "t") || ($notation ne "");
457 if ($notationbracket) {
458 print OUT " <notations>\n";
460 if ($fermata) { print OUT '
461 <fermata type
="upright"/>'."\n"; }
462 if ($trill eq "t") { print OUT ' <ornaments
>
467 if ($notation ne "") {
468 print OUT " $notation\n";
470 if ($notationbracket) {
471 print OUT " </notations>\n";
477 $toprint .= "note: oct. $oct/acc. $acc/dur. $dur/dots $dot/grace,cue $gracecue/pitch $pitch\n";
481 my ($pitch, $acc, $keysig) = @_;
485 if (index ($keysig,$pitch) > -1) {
486 $keysig =~ /^(.).*$/gs;
492 my %acc_alt = ("n", 0, "b", -1, "bb", -2, "x", 1, "xx", 2);
493 if ($acc_alt{$acc} ne "") {
494 $alt = $acc_alt{$acc};
498 return "<alter>$alt</alter>\n";
504 my ($duration, $dots) = @_;
506 if ($duration.$dots ne "") {
507 my %du=("1",4*$divisions,"2",2*$divisions,"4",$divisions,
508 "8",$divisions/2,"6",$divisions/4,"3",$divisions/8,
509 "5",$divisions/16,"7",$divisions/32,
510 "9",$divisions*8,"0",$divisions*16); # breve/long
511 $old_duration = $du{$duration};
512 if ($old_duration eq "") {
513 print_error("strange duration '$duration'\n");
515 my $add = $old_duration;
516 while ($dots ne "") {
518 $old_duration += $add;
519 $dots =~ /^.(.*)$/gs;
523 return $old_duration;
530 $octave =~ /^(.)(.*)$/gs;
532 $old_octave = 4 - length $octave;
534 $old_octave = 3 + length $octave;
543 if ($timesig eq "c3") {
544 $timesig = "3/2"; # it would be better to display it as "C". Example: 451.023.814
546 if ($timesig =~ /^c(\d+)\/(\d+)$/gs) {
547 $timesig = "$1/$2"; # it would be better to show the "C"
550 if ($timesig eq "0" || $timesig eq "") { # unclear how to handle absence of time signature.
551 $timesig ='<time symbol
="common">
553 <beat
-type
>4</beat
-type
>
555 '; # using 4/4 for now.
556 ($beats, $beattype) = (4,4);
557 } elsif ($timesig =~ /^c(\/?)$/gi) {
559 $timesig = '<time symbol
="cut">
561 <beat
-type
>2</beat
-type
>
564 ($beats, $beattype) = (2,2);
566 $timesig = '<time symbol
="common">
568 <beat
-type
>4</beat
-type
>
571 ($beats, $beattype) = (4,4);
573 } elsif ($timesig =~ /^(\d+)\/(\d+)$/gs) {
574 ($beats, $beattype) = ($1, $2);
576 <beats
>'.$beats.'</beats
>
577 <beat
-type
>'.$beattype.'</beat
-type
>
581 print_error("Time signature '$timesig' looks strange.\n");
582 # $timesig = ""; we assume 4/4 just to get something legible:
583 ($beats, $beattype) = (4,4);
585 <beats
>'.$beats.'</beats
>
586 <beat
-type
>'.$beattype.'</beat
-type
>
596 print "\nAn error occurred; context:\n\n$toprint\n
604 while (<STDIN>) { $res .= $_; } # read all lines
606 if (!(open FH, $fn)) {
609 while (<FH>) { $res .= $_; } # read all lines