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 # Store all alterations already used in the current measure, so that e.g.
  67 # xCC also detects the second note as a Cis! Needs to be reset at the
  68 # beginning of a new bar.
  69 %active_alterations = {};
  70
  71 ($mday, $mon, $year) = (localtime()) [3..5];
  72 $encoding_date = sprintf("%4d-%02d-%02d", $year + 1900, $mon+1, $mday);
  73
  74 $TIE = 0;
  75
  76 foreach $a (@ARGV) {
  77   $p = read_file($a);
  78   $toprint = "";
  79   if ($format eq "rism") {
  80     $p =~ s/\s*\=\=+\s*(.*?)\s*\=\=+\s*/$1/sg;
  81     $p =~ s/\s*included.*?-------------*\s*(.*?)\s*/$1/s;
  82
  83     ($q, $r) = ($p, $p);
  84     if ($q !~ /^.*1\.1\.1.*$/gsx && $r =~ /^.*plain.*$/gsx) {
  85       print_error("$a contains 'plain', but not 1.1.1!\n");
  86     } else {
  87       if ($p =~ /^\s*([^\n]+)\n(.*?)\n((\d+\.\d+\.\d.*?plain.*?\n)+)(.*?)\n?([^\n]+)\n([^\n]+)\s*$/gs)    {
  88         my ($comp, $title, $incipits, $sonst, $libsig, $rismsig) = ($1, $2, $3, $5, $6, $7);
  89
  90         $toprint .= "
  91 COMPOSER:   $comp
  92 TITLE:      $title
  93 INCIPIT(S): $incipits
  94 OTHER INFO: $sonst
  95 LIB. SIGN.: $libsig
  96 RISM SIGN.: $rismsig\n\n";
  97         parse_rism_incipits($incipits, $comp, $title, $sonst, $libsig, $rismsig);
  98       }
  99       else {
 100         if (index($p,"plain&easy") > -1) {
 101           print_error("Ignoring the following text:\n\n\n$p\n\n\n");
 102         }
 103       }
 104     }
 105   } else {
 106     # Just a plaine & easie snippet, without any further RISM fields
 107     if ($a eq "-") {
 108       $filename = "out.xml";
 109     } else {
 110       $filename = basename ($a, ".pae") . ".xml";
 111     }
 112     parse_pe ($filename, $p, "", "", "", "", "", "", "");
 113   }
 114 }
 115
 116
 117 ##############################################################################
 118 ### RISM file parsing
 119 ##############################################################################
 120
 121 sub parse_rism_incipits {
 122   my ($incipits, $comp, $title, $sonst, $libsig, $rismsig) = @_;
 123
 124   $toprint .= "parsing:   $incipits\n";
 125
 126   while ($incipits =~ /^(\d+\.\d+\..+?)(\d+\.\d+\..*)$/gs) {
 127     my ($inc1) = $1;
 128     $incipits = $2;
 129     parse_rism_incipit($inc1, $comp, $title, $sonst, $libsig, $rismsig);
 130   }
 131   parse_rism_incipit($incipits, $comp, $title, $sonst, $libsig, $rismsig);
 132 }
 133
 134 sub parse_rism_incipit {
 135   my ($pe, $comp, $title, $sonst, $libsig, $rismsig) = @_;
 136
 137   if ($pe =~ /^\s*(\d+\.\d+\.\d)(\.|:)\s*(.*?)\nplain&easy:\s*(.*)$/gs) {
 138     my ($inr, $instr, $pecode) = ($1, $3, $4);
 139
 140     my $filename="$rismsig-$inr.xml";
 141     $filename =~ s/RISM\s*A\/II\s*:?\s*//gs;
 142
 143     foreach $_ ($rismsig,$title,$inr,$instr,$comp,$libsig,$sonst)
 144     {
 145         s/
 146 //;
 147     }
 148     $toprint .= "
 149 INCIPIT NO.:  $inr
 150 INSTR.:       $instr\n";
 151     parse_pe ($filename, $pecode, $inr, $instr, $comp, $title, $sonst, $libsig, $rismsig);
 152
 153   } else {
 154     print_error("could not parse $pe\n");
 155   }
 156 }
 157
 158
 159 ##############################################################################
 160 ### pure Plaine & Easie data parsing
 161 ##############################################################################
 162
 163 sub parse_pe {
 164   my ($filename, $pe, $inr, $instr, $comp, $title, $sonst, $libsig, $rismsig) = @_;
 165
 166   $pe =~ s/@ü/@0ü/gs; # make missing time signature explicit
 167   while ($pe =~ s/([^\-])(\d+)(\'|\,)(A|B|C|D|E|F|G)/$1$3$2$4/gs) {};  # octave first, then duration. Truly global.
 168
 169   if ($pe =~ /^\s*(%([\w\-\+\d]+))?(@([\d\w\/]+))?\s*&?\s*(\$([^ü]*))?ü(.*)$/gs) {
 170     my ($clef, $timesig, $keysig, $rest) = ($2, $4, $6, $7);
 171
 172     print "Writing $filename...\n";
 173     open(OUT, ">$filename");
 174
 175
 176     print OUT '<?xml version="1.0" encoding="iso-8859-1" standalone="no"?>
 177 <!DOCTYPE score-partwise PUBLIC "-//Recordare//DTD MusicXML 2.0 Partwise//EN" "http://www.musicxml.org/dtds/partwise.dtd">
 178 <score-partwise>
 179 ';
 180     print OUT " <work>\n" if ($rismsig || $title);
 181     print OUT "         <work-number>$rismsig</work-number>\n" if ($rismsig);
 182     print OUT "         <work-title>$title</work-title>\n" if ($title);
 183     print OUT " </work>\n" if ($rismsig || $title);
 184     print OUT " <movement-number>$inr</movement-number>\n" if ($inr);
 185     print OUT " <movement-title>$instr</movement-title>\n" if ($instr);
 186     print OUT " <identification>\n";
 187     print OUT "         <creator type=\"composer\">$comp</creator>\n" if ($comp);
 188     print OUT '         <encoding>
 189                         <software>pae2xml by R. Typke</software>
 190                         <encoding-date>'.$encoding_date.'</encoding-date>
 191                 </encoding>
 192 ';
 193     print OUT "         <source>$libsig</source>\n" if ($libsig);
 194     print OUT ' </identification>
 195         <part-list>
 196                 <score-part id="P1">
 197                         <part-name>'.$sonst.'</part-name>
 198                 </score-part>
 199         </part-list>
 200         <part id="P1">
 201                 <measure number="1">
 202                         <attributes>
 203                                 <divisions>'.$divisions.'</divisions>
 204 '.keysignature ($keysig)
 205 .timesignature ($timesig)
 206 .clef ($clef)
 207 .'                      </attributes>
 208 ';
 209
 210
 211     $toprint .= "
 212 CLEF:         $clef
 213 KEY SIG.:     $keysig
 214 TIME SIG.:    $timesig
 215 REST:         $rest\n";
 216     parse_notes($rest, $keysig);
 217   }
 218   else { print_error("could not parse $pe\n"); }
 219   print OUT "   </part>
 220 </score-partwise>\n";
 221   close OUT;
 222 }
 223
 224 # Repeat $1 by a count of $2
 225 sub repeat {
 226   (my $e, my $count) = @_;
 227   my $res = "";
 228   for (my $i=1; $i <= $count; ++$i)
 229   {
 230     $res .= $e;
 231   }
 232   return $res;
 233 }
 234
 235 sub parse_notes {
 236   my ($notes, $keysig) = @_;
 237   my $qq = 0; # in group of cue notes
 238
 239   my $meas = 2;   # measure number
 240   my $mopen = 1;  # measure tag still open
 241
 242   if ($notes =~ /^\s*(.*?)\s*$/) {
 243     $notes = $1;
 244   }
 245
 246   $notes =~ s/!([^!]*)!(f*)/repeat($1, length($2)+1)/gse;  # write out repetitions
 247   $notes =~ s/\{([^\}]*)\}/$1/gs; # ignore beamings
 248   while ( $notes =~ s/(:?\/+:?|^)([^\/:]*)(:?\/+:?)i(:?\/+:?)/$1$2$3$2$4/gs) {}; # replace whole-measure repeats (i notation)
 249
 250   $notes =~ s/(\d+)\(([^;]+\))/\($1$2/gs;       # pull note lengths into fermatas or triplets
 251   $notes =~ s/(xx|x|bb|b|n)\(/\($1/gs;       # pull accidentals into tuplets or fermatas:
 252   $notes =~ s/(\d+)(xx|x|bb|b|n)(A|B|C|D|E|F|G)/$2$1$3/gs;  # accidentals first, then duration
 253
 254   $notes =~ s/(\.|\d|\,|\')qq/qq$1/gs; # pull beginning mark of group of grace notes in front of corresponding notes
 255   $notes =~ s/(xx|x|bb|b|n)qq/qq$1/gs;  # qq first, then parts of notes
 256   $notes =~ s/([\.\d,'xbn])+(q|g)/$2$1/gs; # q and g 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           reset_measure_attributes ();
 294           if ($notes ne "") {
 295             print OUT '         <measure number="'.$meas.'">
 296 ';
 297             $meas++;
 298           } else {
 299             $mopen = 0;
 300           }
 301         }
 302       }
 303     } elsif ($notes =~ /^((g|q)?(\,|\')*(x|xx|b|bb|n)?\d*\.*(\-|A|B|C|D|E|F|G)t?\+?)(.*)$/) {  # a note
 304       ($note, $notes) = ($1,$6);
 305       parse_note($note, $keysig, "", "", $qq);
 306     } elsif ($notes =~ /^(\((g|q)?(\,|\')*(x|xx|b|bb|n)?\d*\.*(\-|A|B|C|D|E|F|G)[t\+]*\)[t\+]*)(.*)$/) {  # one note with a fermata
 307       ($note, $notes) = ($1,$6);
 308       parse_note($note, $keysig, "", "", $qq);
 309     } elsif ($notes =~ /^(\(((g|q)?(\,|\')*(x|xx|b|bb|n)?\d*\.*(\-|A|B|C|D|E|F|G)t?\+?){3}\))(.*)$/) {  # a triplet
 310       ($triplet, $notes) = ($1,$7);
 311       #      print "TRIPLET: ".$triplet." -> ";
 312       $triplet =~ /^\(((g|q)?(\,|\')*(x|xx|b|bb|n)?\d*\.*(\-|A|B|C|D|E|F|G)t?\+?)(.*)\)$/gs;
 313       ($note, $triplet) = ($1,$6);
 314       #print "$note $triplet\n";
 315       parse_note($note, $keysig, '<tuplet type="start"/>', '                            <time-modification>
 316                                         <actual-notes>3</actual-notes>
 317                                         <normal-notes>2</normal-notes>
 318                                 </time-modification>', $qq);
 319       $triplet =~ /^((g|q)?(\,|\')*(x|xx|b|bb|n)?\d*\.*(\-|A|B|C|D|E|F|G)t?\+?)(.*)$/gs;
 320       ($note, $triplet) = ($1,$6);
 321       #print "$note $triplet\n";
 322       parse_note($note, $keysig,  '', '                         <time-modification>
 323                                         <actual-notes>3</actual-notes>
 324                                         <normal-notes>2</normal-notes>
 325                                 </time-modification>', $qq);
 326       parse_note($triplet,  $keysig, '<tuplet type="stop"/>',  '                                <time-modification>
 327                                         <actual-notes>3</actual-notes>
 328                                         <normal-notes>2</normal-notes>
 329                                 </time-modification>', $qq);
 330     } elsif ($notes =~ /^((\d+)\(((g|q)?(\,|\')*(x|xx|b|bb|n)?\d*\.*(\-|A|B|C|D|E|F|G)t?\+?)+\;(\d+)\))(.*)$/)  {  # an n-tuplet
 331       ($tuplet, $notes) = ($1,$9);
 332       #      print "N-TUPLET: ".$tuplet." -> ";
 333       $tuplet =~ /^(\d+)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*);(\d)\)$/gs;
 334       ($combdur, $note, $tuplet, $numval) = ($1,$2,$7,$8);
 335       #print "i=$combdur, n=$numval; $note / $tuplet\n";
 336       my $ind_dur = duration($combdur)/$numval;
 337       # my $norm_notes =
 338       my $act_notes = $numval;
 339       parse_note($note, $keysig, '<tuplet type="start"/>', '                            <time-modification>
 340                                         <actual-notes>'.$act_notes.'</actual-notes>
 341                                         <normal-notes>1</normal-notes>
 342                                 </time-modification>', $qq);
 343       while ($tuplet =~ /^((g|q)?(\,|\')*(x|xx|b|bb|n)?\d*\.*(\-|A|B|C|D|E|F|G)t?\+?)(.+)$/gs) {
 344         ($note, $tuplet) = ($1,$6);
 345         #print "$note / $tuplet\n";
 346         parse_note($note, $keysig,  '', '                               <time-modification>
 347                                         <actual-notes>'.$act_notes.'</actual-notes>
 348                                         <normal-notes>1</normal-notes>
 349                                 </time-modification>', $qq);
 350       }
 351       parse_note($tuplet,  $keysig, '<tuplet type="stop"/>',  '                         <time-modification>
 352                                         <actual-notes>'.$act_notes.'</actual-notes>
 353                                         <normal-notes>1</normal-notes>
 354                                 </time-modification>', $qq);
 355     } elsif ($notes =~ /^(%(\w(-|\+)\d))(.*)$/) {  # Clef change
 356       ($clef,$notes) = ($2,$4);
 357       print OUT "                       <attributes>\n";
 358       print OUT clef ($clef);
 359       print OUT "                       </attributes>\n";
 360     } elsif ($notes =~ /^@(\d\/\d|c\/?)\s*(.*)$/) {  # time signatue change
 361       ($timesig,$notes) = ($1,$2);
 362       print OUT "                       <attributes>\n";
 363       print OUT timesignature($timesig);
 364       print OUT "                       </attributes>\n";
 365     } elsif ($notes =~ /^\$((b|x)[ABCDEFG]*)\s*(.*)$/) {  # key signature change
 366       ($keysig, $notes) = ($1, $3);
 367       print OUT "                       <attributes>\n";
 368       print OUT keysignature ($keysig);
 369       print OUT "                       </attributes>\n";
 370     } elsif ($notes =~ /^(:?\/+:?)(.*)$/) {  # Barline (and repeats)
 371       $barline = $1;
 372       $notes = $2;
 373       if ($barline =~ /^:\/\/:/) {
 374         print OUT '                     <barline location="right">
 375                                 <bar-style>light-light</bar-style>
 376                                 <repeat direction="backward"/>
 377                         </barline>
 378 ';
 379       } elsif ($barline =~ /^:\/\/$/ ) {
 380           print OUT '                   <barline location="right">
 381                                 <bar-style>light-heavy</bar-style>
 382                                 <repeat direction="backward"/>
 383                         </barline>
 384 ';
 385       } elsif ($barline =~ /^\/\/$/) {
 386         print OUT '                     <barline location="right">
 387                                 <bar-style>light-light</bar-style>
 388                         </barline>
 389 ';
 390       }
 391       print OUT "               </measure>\n";
 392       reset_measure_attributes ();
 393       if ($notes ne "") {
 394         print OUT '             <measure number="'.$meas.'">
 395 ';
 396         if ($barline =~ /^\/\/:$/) {
 397           print OUT '                   <barline location="left">
 398                                 <bar-style>heavy-light</bar-style>
 399                                 <repeat direction="forward"/>
 400                         </barline>
 401 ';
 402         } elsif ($barline =~ /^:\/\/:$/) {
 403           print OUT '                   <barline location="left">
 404                                 <repeat direction="forward"/>
 405                         </barline>
 406 ';
 407         }
 408         print OUT $clefattr;
 409         $meas++;
 410       } else {
 411         $mopen = 0;
 412       }
 413       $toprint .= "bar line\n";
 414     } #elsif ($notes =~ /^(\d*\.*\-)(.*)$/) {
 415       #($rst, $notes) = ($1, $2);
 416       #$toprint .= "rest: $rst\n";
 417       #$rst =~ /^(\d*)(\.*)\-$/;
 418       #($rst, $dots) =($1,$2);
 419       #print OUT '                      <note>
 420         #                       <rest />
 421         #                       <duration>'.duration($rst, $dots).'</duration>
 422 #'.#                            <type>quarter</type>
 423 #'
 424 #                       </note>
 425 #';
 426     elsif ($notes =~ /^\((\=)\)(.*)$/) {  # a bar of rest with a fermata
 427       ($rst, $notes) = ($1, $2);
 428       $toprint .= "rest: $rst\n";
 429       print OUT '                       <note>
 430                                 <rest />
 431                                 <duration>'.($beats*$divisions*4/$beattype).'</duration>
 432                                 <notations>
 433                                         <fermata type="upright"/>
 434                                 </notations>
 435                         </note>
 436 ';
 437     }
 438     elsif ($notes =~ s/(\d+\.*)\(((g|q)?(\,|\')*(x|xx|b|bb|n)?\d*\.*(\-|A|B|C|D|E|F|G)t?\+?)\)/\($1$2\)/gs) { # pull duration into fermata parentheses
 439       #      print "after replacement: $notes\n"; exit;
 440     }
 441     elsif ($notes =~ /^ +(.*)$/) {
 442       $notes = $1;
 443       print("Invalid space encountered in notes before $notes\n");
 444     }
 445     else {
 446       print_error("got stuck with $notes\n");
 447       $notes = "";
 448     }
 449   }
 450   if ($mopen) {
 451     print OUT "         </measure>\n";
 452     reset_measure_attributes ();
 453   }
 454 }
 455
 456
 457 sub parse_note {
 458   my($note, $keysig, $notation, $addition, $in_qq_group) = @_;
 459
 460   my ($fermata) = (0);
 461   my ($actualnotes, $normalnotes) = (1,1);
 462
 463   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*$/) {
 464     ($actualnotes, $normalnotes) = ($1, $2);
 465   }
 466
 467   if ($note =~ /^\((.*)\)(.*)$/) {
 468     $note = "$1$2";
 469     $fermata = 1;
 470   }
 471
 472   $note =~ /^(g|q)?((\,|\')*)(x|xx|b|bb|n)?(\d*)(\.*)(\-|A|B|C|D|E|F|G)(t?)(\+?)$/;
 473   my ($gracecue, $oct, $acc, $dur, $dot, $pitch, $trill, $tie) = ($1, $2, $4, $5, $6, $7, $8, $9);
 474
 475   print OUT '                   <note>
 476 ';
 477   if ($gracecue eq "g") {
 478     print OUT '                         <grace slash="yes" steal-time-following="33"/>
 479 ';
 480   }
 481   if ($gracecue eq "q" || $in_qq_group) {
 482     print OUT '                         <cue/>
 483 ';
 484   }
 485   if ($pitch eq "-") {
 486     print OUT "                         <rest />\n";
 487   } else {
 488     print OUT '                         <pitch>
 489                                         <step>'.$pitch.'</step>
 490 '.alter($pitch, $acc, $keysig)
 491 .'                                      <octave>'.octave($oct).'</octave>
 492                                 </pitch>
 493 ';
 494   }
 495   if ($gracecue ne "g") {
 496     print OUT '                         <duration>'.(duration($dur, $dot)*$normalnotes/$actualnotes).'</duration>
 497 ';
 498   }
 499
 500   $tienotation = "";
 501   if ($tie eq "+") {
 502     if ($TIE) {
 503       $tienotation = "                                  <tied type=\"stop\"/>\n";
 504     }
 505     $tienotation .= "                                   <tied type=\"start\"/>\n";
 506     if (!$TIE) {
 507       $TIE = 1;
 508       print OUT '                               <tie type="start"/>
 509 ';
 510     }
 511   } else {
 512     if ($TIE) {
 513       print OUT '                               <tie type="stop"/>
 514 ';
 515       $tienotation = "                                  <tied type=\"stop\"/>\n";
 516       $TIE = 0;
 517     }
 518   }
 519
 520   # Determine graphic notehead: acciaccaturas are always 8th, otherwise use duration
 521   if ($gracecue eq "g") {
 522     print OUT "                                 <type>eighth</type>\n";
 523   } else {
 524     print OUT notehead ($dur, $dot);
 525   }
 526   # If we have an explicit accidental on the note, print the <accidental> tag
 527   print OUT accidental_explicit ($acc);
 528
 529   print OUT $addition;
 530
 531   my $notationbracket = $fermata || $tienotation || ($trill eq "t") || ($notation ne "");
 532   if ($notationbracket) {
 533     print OUT "                         <notations>\n";
 534   }
 535   if ($tienotation) {
 536     print OUT $tienotation;
 537   }
 538   if ($fermata) {
 539     print OUT "                                 <fermata type=\"upright\"/>\n";
 540   }
 541   if ($trill eq "t") {
 542     print OUT '                                 <ornaments>
 543                                                 <trill-mark/>
 544                                         </ornaments>
 545 ';
 546   }
 547   if ($notation ne "") {
 548     print OUT "                         $notation\n";
 549   }
 550   if ($notationbracket) {
 551     print OUT "                         </notations>\n";
 552   }
 553
 554   print OUT '                   </note>
 555 ';
 556
 557   $toprint .= "note: oct. $oct/acc. $acc/dur. $dur/dots $dot/grace,cue $gracecue/pitch $pitch\n";
 558 }
 559
 560 sub reset_measure_attributes {
 561   %active_alterations = {};
 562   # TODO: reset all measure-only attributes, like manual accidentals
 563 }
 564
 565 sub alter {
 566   my ($pitch, $acc, $keysig) = @_;
 567
 568   my $alt = 0;
 569   # If we had the same pitch with explicit alteration already in the current
 570   # measure, that alteration goes on, unless the current note has an explicit
 571   # alteration
 572   if ($acc eq "") {
 573     $acc = $active_alterations{$pitch};
 574   } else {
 575     # Store the explicit alteration of the current pitch!
 576     $active_alterations{$pitch} = $acc;
 577   }
 578
 579   if (index ($keysig,$pitch) > -1) {
 580     $keysig =~ /^(.).*$/gs;
 581     if ($1 eq 'x') {
 582       $alt = 1;
 583     } else {$alt = -1;}
 584   }
 585
 586   my %acc_alt = ("n", 0, "b", -1, "bb", -2, "x", 1, "xx", 2);
 587   if ($acc_alt{$acc} ne "") {
 588     $alt = $acc_alt{$acc};
 589   }
 590
 591   if ($alt != 0) {
 592     return "\t\t\t\t\t<alter>$alt</alter>\n";
 593   }
 594   return "";
 595 }
 596
 597 sub accidental_explicit {
 598   my ($acc) = @_;
 599   my %accidentals = ("xx", "double-sharp", "x", "sharp", "n", "natural", "b", "flat", "bb", "flat-flat");
 600   my $this_acc = $accidentals{$acc};
 601   if ($this_acc) {
 602     return "\t\t\t\t<accidental>$this_acc</accidental>\n";
 603   } else {
 604     return "";
 605   }
 606 }
 607
 608 sub notehead {
 609   my ($duration, $dots) = @_;
 610   if ($duration.$dots ne "") {
 611     my %du=("0", "long", "9", "breve", "1", "whole", "2", "half", "4", "quarter",
 612             "8", "eighth", "6", "16th", "3", "32nd", "5", "64th", "7", "128th");
 613     my $res = "                         <type>$du{$duration}</type>\n";
 614     $res .= repeat ("                                   <dot/>\n", length ($dots));
 615     $old_type = $res;
 616   }
 617   return $old_type;
 618 }
 619
 620
 621
 622 sub duration {
 623   my ($duration, $dots) = @_;
 624   if ($duration.$dots eq "7.") {
 625     print_error ("Neumic notation is not supported by MusicXML!");
 626   }
 627
 628   if ($duration.$dots ne "") {
 629     my %du=("1",4*$divisions,"2",2*$divisions,"4",$divisions,
 630             "8",$divisions/2,"6",$divisions/4,"3",$divisions/8,
 631             "5",$divisions/16,"7",$divisions/32,
 632             "9",$divisions*8,"0",$divisions*16); # breve/long
 633     $old_duration = $du{$duration};
 634     if ($old_duration eq "") {
 635       print_error("strange duration '$duration'\n");
 636     }
 637     my $add = $old_duration;
 638     while ($dots ne "") {
 639       $add /= 2;
 640       $old_duration += $add;
 641       $dots =~ /^.(.*)$/gs;
 642       $dots = $1;
 643     }
 644   }
 645   return $old_duration;
 646 }
 647
 648 sub octave {
 649   my ($octave) = @_;
 650
 651   if ($octave ne "") {
 652     $octave =~ /^(.)(.*)$/gs;
 653     if ($1 eq ",") {
 654       $old_octave = 4 - length $octave;
 655     } else {
 656       $old_octave = 3 + length $octave;
 657     }
 658   }
 659   return $old_octave;
 660 }
 661
 662 sub clef {
 663   my ($clef) = @_;
 664   my $clefoctave = '';
 665   if ($clef =~ /^(\w)(\-|\+)(\d)$/) {
 666     ($clefsign, $clefline) = ($1, $3);
 667     if ($2 =~ /^\+$/) {
 668       print "Warning: Mensural clefs are not supported by MusicXML, using modern clef (input: $clef)\n";
 669     }
 670     if ($clefsign eq 'g') {
 671       $clefsign = "G";
 672       $clefoctave = "                                   <clef-octave-change>-1</clef-octave-change>\n";
 673     }
 674   } else {
 675     ($clefsign, $clefline) = ("G", 2);
 676   }
 677   return '                              <clef>
 678                                         <sign>'.$clefsign.'</sign>
 679                                         <line>'.$clefline.'</line>
 680 '.$clefoctave.'                         </clef>
 681 ';
 682 }
 683
 684 sub keysignature {
 685   my ($keysig) = @_;
 686
 687   # TODO: How is a change to C major represented? by "$ " or "$x " or "$b "?
 688   #       At the beginning, the $ part is left out, but mid-piece key changes
 689   #       need to way to clear all accidentals! We accept all three cases above!
 690   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);
 691   $keysig =~ s/(\s+)|&//gs;  # it is unclear what the & means, so we'll ignore it for now.
 692   $keysig =~ s/\[|\]//gs; # IGNORING brackets around a key sig.
 693   $fifths = $fif{$keysig};
 694   if ($fifths eq "") {
 695     $fifths = "0";
 696     print_error("Strange key signature '$keysig'.\n");
 697   }
 698   return '                              <key>
 699                                         <fifths>'.$fifths.'</fifths>
 700                                 </key>
 701 ';
 702 }
 703
 704
 705 sub timesignature {
 706   my ($timesig) = @_;
 707
 708   if ($timesig eq "c3") {
 709     $timesig = "3/2";  # it would be better to display it as "C". Example: 451.023.814
 710   }
 711   if ($timesig =~ /^c(\d+)\/(\d+)$/gs) {
 712     $timesig = "$1/$2";  # it would be better to show the "C"
 713   }
 714
 715   if ($timesig eq "0" || $timesig eq "") {  # unclear how to handle absence of time signature.
 716     $timesig ='                         <time symbol="common">
 717                                         <beats>4</beats>
 718                                         <beat-type>4</beat-type>
 719                                 </time>
 720 ';  # using 4/4 for now.
 721     ($beats, $beattype) = (4,4);
 722   } elsif ($timesig =~ /^c(\/?)$/gi) {
 723     if ($1 eq "/") {
 724       $timesig = '                              <time symbol="cut">
 725                                         <beats>2</beats>
 726                                         <beat-type>2</beat-type>
 727                                 </time>
 728 ';
 729       ($beats, $beattype) = (2,2);
 730     } else {
 731       $timesig = '                              <time symbol="common">
 732                                         <beats>4</beats>
 733                                         <beat-type>4</beat-type>
 734                                 </time>
 735 ';
 736       ($beats, $beattype) = (4,4);
 737     }
 738   } elsif ($timesig =~ /^(\d+)\/(\d+)$/gs) {
 739     ($beats, $beattype) = ($1, $2);
 740     $timesig = '                                <time>
 741                                         <beats>'.$beats.'</beats>
 742                                         <beat-type>'.$beattype.'</beat-type>
 743                                 </time>
 744 ';
 745   } else {
 746     print_error("Time signature '$timesig' looks strange.\n");
 747     #   $timesig = "";   we assume 4/4 just to  get something legible:
 748     ($beats, $beattype) = (4,4);
 749     $timesig = '                                <time>
 750                                         <beats>'.$beats.'</beats>
 751                                         <beat-type>'.$beattype.'</beat-type>
 752                                 </time>
 753 ';
 754   }
 755   return $timesig;
 756 }
 757
 758 sub print_error {
 759   my ($msg) = @_;
 760
 761   print "\nAn error occurred; context:\n\n$toprint\n
 762 Error: $msg\n";
 763 }
 764
 765 sub read_file {
 766   my ($fn) = @_;
 767   my $res = "";
 768   if ($fn eq "-") {
 769       while (<STDIN>) { $res .= $_; } # read all lines
 770   } else {
 771     if (!(open FH, $fn)) {
 772       return "";
 773     }
 774     while (<FH>) { $res .= $_; } # read all lines
 775     close (FH);
 776   }
 777   return $res;
 778 }