pae2xml.pl

   1 #!/usr/bin/perl
   2
   3
   4 # Copyright (C) 2003 Rainer Typke
   5 # Copyright (C) 2010 Reinhold Kainhofer <reinhold@kainhofer.com>
   6 #pae2xml is licensed under the terms of the GNU General Public License Version
   7 #2 as published by the <a href="http://www.fsf.org/" target="_top">Free Software Foundation</a>.
   8 #This gives you legal permission to copy, distribute and/or modify <em>pae2xml</em> under
   9 #certain conditions. Read
  10 #the <a href="http://www.gnu.org/copyleft/gpl.html" target="_top">online version of the license</a>
  11 #for more details. pae2xml is provided AS IS with NO WARRANTY OF ANY KIND,
  12 #INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY, AND FITNESS FOR A PARTICULAR PURPOSE.
  13
  14 our $script = "pae2xml.pl";
  15 our $version = "1.0";
  16
  17 ### Handle command-line options
  18
  19 # import module
  20 use Getopt::Long;
  21 use File::Basename;
  22
  23 our $format = 'rism';
  24
  25 sub print_help {
  26   print 'pae2xml.pl [OPTIONS...] FILE
  27
  28   Converts the Plaine & Easie file FILE to MusicXML. If FILE is -, STDIN is used.
  29
  30   Possible options:
  31     -h, --help          Prints out this help message
  32     --format=FORMAT, -f FORMAT
  33                         Interprets input file as FORMAT. Possible values are
  34                            rism, pae (default: rism)
  35     -v, -- version      Prints out version information
  36 ';
  37 }
  38 sub print_version {
  39   print "$script $version
  40   Copyright (C) 2003 Rainer Typke
  41   Copyright (C) 2010 Reinhold Kainhofer <reinhold\@kainhofer.com>
  42 ";
  43 }
  44 sub handle_options {
  45   my $print_help = 0;
  46   my $print_version = 0;
  47   my $result = GetOptions ("f|format=s" => \$format, "help|h" => \$print_help, "version|v" => \$print_version);
  48   if ($print_version) {
  49     print_version ();
  50     exit 0;
  51   }
  52   if ($print_help || (@ARGV == 0)) {
  53     print_help ();
  54     exit 0;
  55   }
  56 }
  57 handle_options ();
  58
  59
  60
  61 $divisions = 960;
  62 $old_duration = $divisions;
  63 $old_type = "";
  64 $old_octave = 4;
  65
  66 ($mday, $mon, $year) = (localtime()) [3..5];
  67 $encoding_date = sprintf("%4d-%02d-%02d", $year + 1900, $mon+1, $mday);
  68
  69 $TIE = 0;
  70
  71 foreach $a (@ARGV) {
  72   $p = read_file($a);
  73   $toprint = "";
  74   if ($format eq "rism") {
  75     $p =~ s/\s*\=\=+\s*(.*?)\s*\=\=+\s*/$1/sg;
  76     $p =~ s/\s*included.*?-------------*\s*(.*?)\s*/$1/s;
  77
  78     ($q, $r) = ($p, $p);
  79     if ($q !~ /^.*1\.1\.1.*$/gsx && $r =~ /^.*plain.*$/gsx) {
  80       print_error("$a contains 'plain', but not 1.1.1!\n");
  81     } else {
  82       if ($p =~ /^\s*([^\n]+)\n(.*?)\n((\d+\.\d+\.\d.*?plain.*?\n)+)(.*?)\n?([^\n]+)\n([^\n]+)\s*$/gs)    {
  83         my ($comp, $title, $incipits, $sonst, $libsig, $rismsig) = ($1, $2, $3, $5, $6, $7);
  84
  85         $toprint .= "
  86 COMPOSER:   $comp
  87 TITLE:      $title
  88 INCIPIT(S): $incipits
  89 OTHER INFO: $sonst
  90 LIB. SIGN.: $libsig
  91 RISM SIGN.: $rismsig\n\n";
  92         parse_rism_incipits($incipits, $comp, $title, $sonst, $libsig, $rismsig);
  93       }
  94       else {
  95         if (index($p,"plain&easy") > -1) {
  96           print_error("Ignoring the following text:\n\n\n$p\n\n\n");
  97         }
  98       }
  99     }
 100   } else {
 101     # Just a plaine & easie snippet, without any further RISM fields
 102     if ($a eq "-") {
 103       $filename = "out.xml";
 104     } else {
 105       $filename = basename ($a, ".pae") . ".xml";
 106     }
 107     parse_pe ($filename, $p, "", "", "", "", "", "", "");
 108   }
 109 }
 110
 111
 112 ##############################################################################
 113 ### RISM file parsing
 114 ##############################################################################
 115
 116 sub parse_rism_incipits {
 117   my ($incipits, $comp, $title, $sonst, $libsig, $rismsig) = @_;
 118
 119   $toprint .= "parsing:   $incipits\n";
 120
 121   while ($incipits =~ /^(\d+\.\d+\..+?)(\d+\.\d+\..*)$/gs) {
 122     my ($inc1) = $1;
 123     $incipits = $2;
 124     parse_rism_incipit($inc1, $comp, $title, $sonst, $libsig, $rismsig);
 125   }
 126   parse_rism_incipit($incipits, $comp, $title, $sonst, $libsig, $rismsig);
 127 }
 128
 129 sub parse_rism_incipit {
 130   my ($pe, $comp, $title, $sonst, $libsig, $rismsig) = @_;
 131
 132   if ($pe =~ /^\s*(\d+\.\d+\.\d)(\.|:)\s*(.*?)\nplain&easy:\s*(.*)$/gs) {
 133     my ($inr, $instr, $pecode) = ($1, $3, $4);
 134
 135     my $filename="$rismsig-$inr.xml";
 136     $filename =~ s/RISM\s*A\/II\s*:?\s*//gs;
 137
 138     foreach $_ ($rismsig,$title,$inr,$instr,$comp,$libsig,$sonst)
 139     {
 140         s/
 141 //;
 142     }
 143     $toprint .= "
 144 INCIPIT NO.:  $inr
 145 INSTR.:       $instr\n";
 146     parse_pe ($filename, $pecode, $inr, $instr, $comp, $title, $sonst, $libsig, $rismsig);
 147
 148   } else {
 149     print_error("could not parse $pe\n");
 150   }
 151 }
 152
 153
 154 ##############################################################################
 155 ### pure Plaine & Easie data parsing
 156 ##############################################################################
 157
 158 sub parse_pe {
 159   my ($filename, $pe, $inr, $instr, $comp, $title, $sonst, $libsig, $rismsig) = @_;
 160
 161   $pe =~ s/@ü/@0ü/gs; # make missing time signature explicit
 162   while ($pe =~ s/([^\-])(\d+)(\'|\,)(A|B|C|D|E|F|G)/$1$3$2$4/gs) {};  # octave first, then duration. Truly global.
 163
 164   if ($pe =~ /^\s*(%([\w\-\+\d]+))?(@([\d\w\/]+))?\s*&?\s*(\$([^ü]*))?ü(.*)$/gs) {
 165     my ($clef, $timesig, $keysig, $rest) = ($2, $4, $6, $7);
 166
 167     print "Writing $filename...\n";
 168     open(OUT, ">$filename");
 169
 170
 171     print OUT '<?xml version="1.0" encoding="iso-8859-1" standalone="no"?>
 172 <!DOCTYPE score-partwise PUBLIC "-//Recordare//DTD MusicXML 2.0 Partwise//EN" "http://www.musicxml.org/dtds/partwise.dtd">
 173 <score-partwise>
 174 ';
 175     print OUT " <work>\n" if ($rismsig || $title);
 176     print OUT "         <work-number>$rismsig</work-number>\n" if ($rismsig);
 177     print OUT "         <work-title>$title</work-title>\n" if ($title);
 178     print OUT " </work>\n" if ($rismsig || $title);
 179     print OUT " <movement-number>$inr</movement-number>\n" if ($inr);
 180     print OUT " <movement-title>$instr</movement-title>\n" if ($instr);
 181     print OUT " <identification>\n";
 182     print OUT "         <creator type=\"composer\">$comp</creator>\n" if ($comp);
 183     print OUT '         <encoding>
 184                         <software>pae2xml by R. Typke</software>
 185                         <encoding-date>'.$encoding_date.'</encoding-date>
 186                 </encoding>
 187 ';
 188     print OUT "         <source>$libsig</source>\n" if ($libsig);
 189     print OUT ' </identification>
 190         <part-list>
 191                 <score-part id="P1">
 192                         <part-name>'.$sonst.'</part-name>
 193                 </score-part>
 194         </part-list>
 195         <part id="P1">
 196                 <measure number="1">
 197                         <attributes>
 198                                 <divisions>'.$divisions.'</divisions>
 199 '.keysignature ($keysig)
 200 .timesignature ($timesig)
 201 .clef ($clef)
 202 .'                      </attributes>
 203 ';
 204
 205
 206     $toprint .= "
 207 CLEF:         $clef
 208 KEY SIG.:     $keysig
 209 TIME SIG.:    $timesig
 210 REST:         $rest\n";
 211     parse_notes($rest, $keysig);
 212   }
 213   else { print_error("could not parse $pe\n"); }
 214   print OUT "   </part>
 215 </score-partwise>\n";
 216   close OUT;
 217 }
 218
 219 # Repeat $1 by a count of $2
 220 sub repeat {
 221   (my $e, my $count) = @_;
 222   my $res = "";
 223   for (my $i=1; $i <= $count; ++$i)
 224   {
 225     $res .= $e;
 226   }
 227   return $res;
 228 }
 229
 230 sub parse_notes {
 231   my ($notes, $keysig) = @_;
 232   my $qq = 0; # in group of cue notes
 233
 234   my $meas = 2;   # measure number
 235   my $mopen = 1;  # measure tag still open
 236
 237   if ($notes =~ /^\s*(.*?)\s*$/) {
 238     $notes = $1;
 239   }
 240
 241   $notes =~ s/!([^!]*)!(f*)/repeat($1, length($2)+1)/gse;  # write out repetitions
 242   $notes =~ s/\{([^\}]*)\}/$1/gs; # ignore beamings
 243   while ( $notes =~ s/(:?\/+:?|^)([^\/:]*)(:?\/+:?)i(:?\/+:?)/$1$2$3$2$4/gs) {}; # replace whole-measure repeats (i notation)
 244
 245   $notes =~ s/(\d+)\(([^;]+\))/\($1$2/gs;       # pull note lengths into fermatas or triplets
 246   $notes =~ s/(xx|x|bb|b|n)\(/\($1/gs;       # pull accidentals into tuplets or fermatas:
 247   $notes =~ s/(\d+)(xx|x|bb|b|n)(A|B|C|D|E|F|G)/$2$1$3/gs;  # accidentals first, then duration
 248
 249 #  $notes =~ s/x\(/\(x/gs;       # pull accidentals into tuplets or fermatas
 250 #  $notes =~ s/bb\(/\(bb/gs;       # pull accidentals into tuplets or fermatas
 251 #  $notes =~ s/b\(/\(b/gs;       # pull accidentals into tuplets or fermatas
 252 #  $notes =~ s/n\(/\(n/gs;       # pull accidentals into tuplets or fermatas
 253   #  $notes =~ s/(\'+|\,+)\(/\($1/g;       # pull octave marks into tuplets or fermatas
 254
 255   $notes =~ s/(\.|\d|\,|\')qq/qq$1/gs; # pull beginning mark of group of grace notes in front of corresponding notes
 256   $notes =~ s/(xx|x|bb|b|n)qq/qq$1/gs;  # qq first, then parts of notes
 257
 258   while ($notes ne "") {
 259     if ($notes =~ /^(\'+|\,+)(.*)$/) {  # Octave marks
 260       ($oct, $notes) = ($1, $2);
 261       octave($oct);
 262     } elsif ($notes =~ /^qq(.*)$/) {  # Begin grace
 263       $notes = $1;
 264       $qq = 1;
 265     } elsif ($notes =~ /^r(.*)$/) {  # End grace
 266       $notes = $1;
 267       $qq = 0;
 268     } elsif ($notes =~ /^\=(\d*)(\/.*)$/) {  # multi-measure rests
 269       $measrest = $1;
 270       $notes = $2;
 271       if ($measrest eq '') {
 272         $measrest = 1;
 273       }
 274       $toprint .= "$measrest measures of rest.\n";
 275       if ($measrest > 0) {
 276         # Create a real multi-bar rest
 277         print OUT '                     <attributes>
 278                                 <measure-style>
 279                                         <multiple-rest>'.$measrest.'</multiple-rest>
 280                                 </measure-style>
 281                         </attributes>
 282 ';
 283       }
 284       # Now create the measures
 285       for $n (1..$measrest) {
 286         print OUT '                     <note>
 287                                 <rest />
 288                                 <duration>'.($beats*$divisions*4/$beattype).'</duration>
 289                         </note>
 290 ';
 291         if ($n < $measrest) {
 292           print OUT "           </measure>\n";
 293           if ($notes ne "") {
 294             print OUT '         <measure number="'.$meas.'">
 295 ';
 296             $meas++;
 297           } else {
 298             $mopen = 0;
 299           }
 300         }
 301       }
 302     } elsif ($notes =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)$/) {  # a note
 303       ($note, $notes) = ($1,$6);
 304       parse_note($note, $keysig, "", "", $qq);
 305     } elsif ($notes =~ /^(\((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?\))(.*)$/) {  # one note with a fermata
 306       ($note, $notes) = ($1,$6);
 307       parse_note($note, $keysig, "", "", $qq);
 308     } elsif ($notes =~ /^(\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?){3}\))(.*)$/) {  # a triplet
 309       ($triplet, $notes) = ($1,$7);
 310       #      print "TRIPLET: ".$triplet." -> ";
 311       $triplet =~ /^\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)\)$/gs;
 312       ($note, $triplet) = ($1,$6);
 313       #print "$note $triplet\n";
 314       parse_note($note, $keysig, '<tuplet type="start"/>', '                            <time-modification>
 315                                         <actual-notes>3</actual-notes>
 316                                         <normal-notes>2</normal-notes>
 317                                 </time-modification>', $qq);
 318       $triplet =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)$/gs;
 319       ($note, $triplet) = ($1,$6);
 320       #print "$note $triplet\n";
 321       parse_note($note, $keysig,  '', '                         <time-modification>
 322                                         <actual-notes>3</actual-notes>
 323                                         <normal-notes>2</normal-notes>
 324                                 </time-modification>', $qq);
 325       parse_note($triplet,  $keysig, '<tuplet type="stop"/>',  '                                <time-modification>
 326                                         <actual-notes>3</actual-notes>
 327                                         <normal-notes>2</normal-notes>
 328                                 </time-modification>', $qq);
 329     } elsif ($notes =~ /^((\d+)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)+\;(\d+)\))(.*)$/)  {  # an n-tuplet
 330       ($tuplet, $notes) = ($1,$9);
 331       #      print "N-TUPLET: ".$tuplet." -> ";
 332       $tuplet =~ /^(\d+)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*);(\d)\)$/gs;
 333       ($combdur, $note, $tuplet, $numval) = ($1,$2,$7,$8);
 334       #print "i=$combdur, n=$numval; $note / $tuplet\n";
 335       my $ind_dur = duration($combdur)/$numval;
 336       # my $norm_notes =
 337       my $act_notes = $numval;
 338       parse_note($note, $keysig, '<tuplet type="start"/>', '                            <time-modification>
 339                                         <actual-notes>'.$act_notes.'</actual-notes>
 340                                         <normal-notes>1</normal-notes>
 341                                 </time-modification>', $qq);
 342       while ($tuplet =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.+)$/gs) {
 343         ($note, $tuplet) = ($1,$6);
 344         #print "$note / $tuplet\n";
 345         parse_note($note, $keysig,  '', '                               <time-modification>
 346                                         <actual-notes>'.$act_notes.'</actual-notes>
 347                                         <normal-notes>1</normal-notes>
 348                                 </time-modification>', $qq);
 349       }
 350       parse_note($tuplet,  $keysig, '<tuplet type="stop"/>',  '                         <time-modification>
 351                                         <actual-notes>'.$act_notes.'</actual-notes>
 352                                         <normal-notes>1</normal-notes>
 353                                 </time-modification>', $qq);
 354     } elsif ($notes =~ /^(%(\w(-|\+)\d))(.*)$/) {  # Clef change
 355       ($clef,$notes) = ($2,$4);
 356       print OUT "                       <attributes>\n";
 357       print OUT clef ($clef);
 358       print OUT "                       </attributes>\n";
 359     } elsif ($notes =~ /^@(\d\/\d|c\/?)\s*(.*)$/) {  # time signatue change
 360       ($timesig,$notes) = ($1,$2);
 361       print OUT "                       <attributes>\n";
 362       print OUT timesignature($timesig);
 363       print OUT "                       </attributes>\n";
 364     } elsif ($notes =~ /^\$((b|x)[ABCDEFG]*)\s*(.*)$/) {  # key signature change
 365       ($keysig, $notes) = ($1, $3);
 366       print OUT "                       <attributes>\n";
 367       print OUT keysignature ($keysig);
 368       print OUT "                       </attributes>\n";
 369     } elsif ($notes =~ /^(:?\/+:?)(.*)$/) {  # Barline (and repeats)
 370       $barline = $1;
 371       $notes = $2;
 372       if ($barline =~ /^:\/\/:/) {
 373         print OUT '                     <barline location="right">
 374                                 <bar-style>light-light</bar-style>
 375                                 <repeat direction="backward"/>
 376                         </barline>
 377 ';
 378       } elsif ($barline =~ /^:\/\/$/ ) {
 379           print OUT '                   <barline location="right">
 380                                 <bar-style>light-heavy</bar-style>
 381                                 <repeat direction="backward"/>
 382                         </barline>
 383 ';
 384       } elsif ($barline =~ /^\/\/$/) {
 385         print OUT '                     <barline location="right">
 386                                 <bar-style>light-light</bar-style>
 387                                 <repeat direction="backward"/>
 388                         </barline>
 389 ';
 390       }
 391       print OUT "               </measure>\n";
 392       if ($notes ne "") {
 393         print OUT '             <measure number="'.$meas.'">
 394 ';
 395         if ($barline =~ /^\/\/:$/) {
 396           print OUT '                   <barline location="left">
 397                                 <bar-style>heavy-light</bar-style>
 398                                 <repeat direction="forward"/>
 399                         </barline>
 400 ';
 401         } elsif ($barline =~ /^:\/\/:$/) {
 402           print OUT '                   <barline location="left">
 403                                 <repeat direction="forward"/>
 404                         </barline>
 405 ';
 406         }
 407         print OUT $clefattr;
 408         $meas++;
 409       } else {
 410         $mopen = 0;
 411       }
 412       $toprint .= "bar line\n";
 413     } #elsif ($notes =~ /^(\d*\.*\-)(.*)$/) {
 414       #($rst, $notes) = ($1, $2);
 415       #$toprint .= "rest: $rst\n";
 416       #$rst =~ /^(\d*)(\.*)\-$/;
 417       #($rst, $dots) =($1,$2);
 418       #print OUT '                      <note>
 419         #                       <rest />
 420         #                       <duration>'.duration($rst, $dots).'</duration>
 421 #'.#                            <type>quarter</type>
 422 #'
 423 #                       </note>
 424 #';
 425     elsif ($notes =~ /^\((\=)\)(.*)$/) {  # a bar of rest with a fermata
 426       ($rst, $notes) = ($1, $2);
 427       $toprint .= "rest: $rst\n";
 428       print OUT '                       <note>
 429                                 <rest />
 430                                 <duration>'.($beats*$divisions*4/$beattype).'</duration>
 431                                 <notations>
 432                                         <fermata type="upright"/>
 433                                 </notations>
 434                         </note>
 435 ';
 436     }
 437     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
 438       #      print "after replacement: $notes\n"; exit;
 439     }
 440     elsif ($notes =~ /^ +(.*)$/) {
 441       $notes = $1;
 442       print("Invalid space encountered in notes before $notes\n");
 443     }
 444     else {
 445       print_error("got stuck with $notes\n");
 446       $notes = "";
 447     }
 448   }
 449   if ($mopen) {
 450     print OUT "         </measure>\n";
 451   }
 452 }
 453
 454
 455 sub parse_note {
 456   my($note, $keysig, $notation, $addition, $in_qq_group) = @_;
 457
 458   my ($fermata) = (0);
 459   my ($actualnotes, $normalnotes) = (1,1);
 460
 461   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*$/) {
 462     ($actualnotes, $normalnotes) = ($1, $2);
 463   }
 464
 465   if ($note =~ /^\((.*)\)$/) {
 466     $note = $1;
 467     $fermata = 1;
 468   }
 469
 470   $note =~ /^((\,|\')*)(x|xx|b|bb|n)?(\d*)(\.*)(g|q)?(\-|A|B|C|D|E|F|G)(t?)(\+?)$/;
 471   my ($oct, $acc, $dur, $dot, $gracecue, $pitch, $trill, $tie) = ($1, $3, $4, $5, $6, $7, $8, $9);
 472
 473   print OUT '                   <note>
 474 ';
 475   if ($gracecue eq "g") {
 476     print OUT '                         <grace steal-time-following="33"/>
 477 ';
 478   }
 479   if ($gracecue eq "q" || $in_qq_group) {
 480     print OUT '                         <cue/>
 481 ';
 482   }
 483   if ($pitch eq "-") {
 484     print OUT "                         <rest />\n";
 485   } else {
 486     print OUT '                         <pitch>
 487                                         <step>'.$pitch.'</step>
 488 '.alter($pitch, $acc, $keysig)
 489 .'                                      <octave>'.octave($oct).'</octave>
 490                                 </pitch>
 491 ';
 492   }
 493   if ($gracecue ne "g") {
 494     print OUT '                         <duration>'.(duration($dur, $dot)*$normalnotes/$actualnotes).'</duration>
 495 ';
 496   }
 497
 498   $tienotation = "";
 499   if ($tie eq "+") {
 500     if ($TIE) {
 501       $tienotation = "                                  <tied type=\"stop\"/>\n";
 502     }
 503     $tienotation .= "                                   <tied type=\"start\"/>\n";
 504     if (!$TIE) {
 505       $TIE = 1;
 506       print OUT '                               <tie type="start"/>
 507 ';
 508     }
 509   } else {
 510     if ($TIE) {
 511       print OUT '                               <tie type="stop"/>
 512 ';
 513       $tienotation = "                                  <tied type=\"stop\"/>\n";
 514       $TIE = 0;
 515     }
 516   }
 517
 518   # Determine graphic notehead:
 519   print OUT notehead ($dur, $dot);
 520
 521   print OUT $addition;
 522
 523   my $notationbracket = $fermata || $tienotation || ($trill eq "t") || ($notation ne "");
 524   if ($notationbracket) {
 525     print OUT "                         <notations>\n";
 526   }
 527   if ($tienotation) {
 528     print OUT $tienotation;
 529   }
 530   if ($fermata) {
 531     print OUT '
 532                                         <fermata type="upright"/>'."\n"; }
 533   if ($trill eq "t") {
 534     print OUT '                                 <ornaments>
 535                                                 <trill-mark/>
 536                                         </ornaments>
 537 ';
 538   }
 539   if ($notation ne "") {
 540     print OUT "                         $notation\n";
 541   }
 542   if ($notationbracket) {
 543     print OUT "                         </notations>\n";
 544   }
 545
 546   print OUT '                   </note>
 547 ';
 548
 549   $toprint .= "note: oct. $oct/acc. $acc/dur. $dur/dots $dot/grace,cue $gracecue/pitch $pitch\n";
 550 }
 551
 552 sub alter {
 553   my ($pitch, $acc, $keysig) = @_;
 554
 555   my $alt = 0;
 556
 557   if (index ($keysig,$pitch) > -1) {
 558     $keysig =~ /^(.).*$/gs;
 559     if ($1 eq 'x') {
 560       $alt = 1;
 561     } else {$alt = -1;}
 562   }
 563
 564   my %acc_alt = ("n", 0, "b", -1, "bb", -2, "x", 1, "xx", 2);
 565   if ($acc_alt{$acc} ne "") {
 566     $alt = $acc_alt{$acc};
 567   }
 568
 569   if ($alt != 0) {
 570     return "\t\t\t\t\t<alter>$alt</alter>\n";
 571   }
 572   return "";
 573 }
 574
 575 sub notehead {
 576   my ($duration, $dots) = @_;
 577   if ($duration.$dots ne "") {
 578     my %du=("0", "long", "9", "breve", "1", "whole", "2", "half", "4", "quarter",
 579             "8", "eighth", "6", "16th", "3", "32nd", "5", "64th", "7", "128th");
 580     my $res = "                         <type>$du{$duration}</type>\n";
 581     $res .= repeat ("                                   <dot/>\n", length ($dots));
 582     $old_type = $res;
 583   }
 584   return $old_type;
 585 }
 586
 587
 588
 589 sub duration {
 590   my ($duration, $dots) = @_;
 591
 592   if ($duration.$dots ne "") {
 593     my %du=("1",4*$divisions,"2",2*$divisions,"4",$divisions,
 594             "8",$divisions/2,"6",$divisions/4,"3",$divisions/8,
 595             "5",$divisions/16,"7",$divisions/32,
 596             "9",$divisions*8,"0",$divisions*16); # breve/long
 597     $old_duration = $du{$duration};
 598     if ($old_duration eq "") {
 599       print_error("strange duration '$duration'\n");
 600     }
 601     my $add = $old_duration;
 602     while ($dots ne "") {
 603       $add /= 2;
 604       $old_duration += $add;
 605       $dots =~ /^.(.*)$/gs;
 606       $dots = $1;
 607     }
 608   }
 609   return $old_duration;
 610 }
 611
 612 sub octave {
 613   my ($octave) = @_;
 614
 615   if ($octave ne "") {
 616     $octave =~ /^(.)(.*)$/gs;
 617     if ($1 eq ",") {
 618       $old_octave = 4 - length $octave;
 619     } else {
 620       $old_octave = 3 + length $octave;
 621     }
 622   }
 623   return $old_octave;
 624 }
 625
 626 sub clef {
 627   my ($clef) = @_;
 628   my $clefoctave = '';
 629   if ($clef =~ /^(\w)(\-|\+)(\d)$/) {
 630     ($clefsign, $clefline) = ($1, $3);
 631     if ($2 =~ /^\+$/) {
 632       print "Warning: Mensural clefs are not supported by MusicXML, using modern clef (input: $clef)\n";
 633     }
 634     if ($clefsign eq 'g') {
 635       $clefsign = "G";
 636       $clefoctave = "                                   <clef-octave-change>-1</clef-octave-change>\n";
 637     }
 638   } else {
 639     ($clefsign, $clefline) = ("G", 2);
 640   }
 641   return '                              <clef>
 642                                         <sign>'.$clefsign.'</sign>
 643                                         <line>'.$clefline.'</line>
 644 '.$clefoctave.'                         </clef>
 645 ';
 646 }
 647
 648 sub keysignature {
 649   my ($keysig) = @_;
 650
 651   # TODO: How is a change to C major represented? by "$ " or "$x " or "$b "?
 652   #       At the beginning, the $ part is left out, but mid-piece key changes
 653   #       need to way to clear all accidentals! We accept all three cases above!
 654   my %fif=("", 0, "x", 0, "b", 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);
 655   $keysig =~ s/(\s+)|&//gs;  # it is unclear what the & means, so we'll ignore it for now.
 656   $keysig =~ s/\[|\]//gs; # IGNORING brackets around a key sig.
 657   $fifths = $fif{$keysig};
 658   if ($fifths eq "") {
 659     $fifths = "0";
 660     print_error("Strange key signature '$keysig'.\n");
 661   }
 662   return '                              <key>
 663                                         <fifths>'.$fifths.'</fifths>
 664                                 </key>
 665 ';
 666 }
 667
 668
 669 sub timesignature {
 670   my ($timesig) = @_;
 671
 672   if ($timesig eq "c3") {
 673     $timesig = "3/2";  # it would be better to display it as "C". Example: 451.023.814
 674   }
 675   if ($timesig =~ /^c(\d+)\/(\d+)$/gs) {
 676     $timesig = "$1/$2";  # it would be better to show the "C"
 677   }
 678
 679   if ($timesig eq "0" || $timesig eq "") {  # unclear how to handle absence of time signature.
 680     $timesig ='                         <time symbol="common">
 681                                         <beats>4</beats>
 682                                         <beat-type>4</beat-type>
 683                                 </time>
 684 ';  # using 4/4 for now.
 685     ($beats, $beattype) = (4,4);
 686   } elsif ($timesig =~ /^c(\/?)$/gi) {
 687     if ($1 eq "/") {
 688       $timesig = '                              <time symbol="cut">
 689                                         <beats>2</beats>
 690                                         <beat-type>2</beat-type>
 691                                 </time>
 692 ';
 693       ($beats, $beattype) = (2,2);
 694     } else {
 695       $timesig = '                              <time symbol="common">
 696                                         <beats>4</beats>
 697                                         <beat-type>4</beat-type>
 698                                 </time>
 699 ';
 700       ($beats, $beattype) = (4,4);
 701     }
 702   } elsif ($timesig =~ /^(\d+)\/(\d+)$/gs) {
 703     ($beats, $beattype) = ($1, $2);
 704     $timesig = '                                <time>
 705                                         <beats>'.$beats.'</beats>
 706                                         <beat-type>'.$beattype.'</beat-type>
 707                                 </time>
 708 ';
 709   } else {
 710     print_error("Time signature '$timesig' looks strange.\n");
 711     #   $timesig = "";   we assume 4/4 just to  get something legible:
 712     ($beats, $beattype) = (4,4);
 713     $timesig = '                                <time>
 714                                         <beats>'.$beats.'</beats>
 715                                         <beat-type>'.$beattype.'</beat-type>
 716                                 </time>
 717 ';
 718   }
 719   return $timesig;
 720 }
 721
 722 sub print_error {
 723   my ($msg) = @_;
 724
 725   print "\nAn error occurred; context:\n\n$toprint\n
 726 Error: $msg\n";
 727 }
 728
 729 sub read_file {
 730   my ($fn) = @_;
 731   my $res = "";
 732   if ($fn eq "-") {
 733       while (<STDIN>) { $res .= $_; } # read all lines
 734   } else {
 735     if (!(open FH, $fn)) {
 736       return "";
 737     }
 738     while (<FH>) { $res .= $_; } # read all lines
 739     close (FH);
 740   }
 741   return $res;
 742 }