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