mscore-halve

   1 #!/usr/bin/env perl
   2 #
   3 # A program for processing Musescore XML files and halving the times of all the notes
   4 # together with anything else that may be relevant (eg Time Sig, rests, trailing
   5 # '_' after lyrics etc).
   6 #
   7 # Having written this and seen that there isn't really any state preserved from
   8 # from one XML clause to another, it could all be done in an XSLT stylesheet. But I've
   9 # written it now.
  10 #
  11 # Copyright (c) Dirk Koopman 2016
  12 #
  13
  14 use strict;
  15
  16 require 5.10.1;
  17
  18 use XML::LibXML;
  19 use File::Basename;
  20 use File::Temp qw{ :mktemp };
  21 use IO::File;
  22 use v5.10;
  23 use utf8;
  24
  25 our $VERSION = "1.0";
  26
  27 our %half = (                                   # decode from one note length to its half
  28                          qw(
  29                                    maxima long
  30                                    long breve
  31                                    breve whole
  32                                    whole half
  33                                    half quarter
  34                                    quarter eighth
  35                                    eighth 16th
  36                                    16th 32nd
  37                                    32nd 64th
  38                                    64th 128th
  39                                    128th 256th
  40                                    256th 512th
  41                                    512th 1024th
  42                           )
  43                         );
  44 our %yesno = ( qw(yes 1 no 0) ); # used for turning translating yes/no text values
  45
  46
  47 our $dbg = 0;                                   # show debugging
  48 our $removebeam = 1;                    # if set remove any BeamMode clauses
  49
  50 usage() unless @ARGV;
  51
  52 binmode STDOUT, "utf8";
  53
  54 foreach my $fn (@ARGV) {
  55
  56         if ($fn =~ /^-\w/) {
  57                 usage() if $fn =~ /^\-+[\?h]/i;
  58                 $dbg ^= 1 if $fn =~ /^\-+x/;
  59                 $removebeam ^= 1 if $fn =~ /^\-+b/;
  60         } else {
  61                 my ($ifn, $ofn, $tfn);
  62
  63                 my ($name, $path, $suffix) = fileparse($fn, qr/\.[^.]*/);
  64                 if ($suffix eq ".mscx" || $suffix eq ".mscz") {
  65                         $ifn = $fn;
  66                         $ofn = $path . $name . "-halved.mscx";
  67
  68                         # extract out the zipped up .mscx file from an .mscz archive
  69                         if ($suffix eq '.mscz') {
  70                                 $tfn = mktemp("/tmp/msczXXXXXXX");
  71                                 my $xifn = $ifn;
  72                                 $xifn =~ s/z$/x/;
  73                                 system("unzip -p $ifn $xifn > $tfn");
  74                                 $ifn = $tfn;    # the tmp file is the actual input.
  75                         }
  76                 } else {
  77                         usage("Only Musescore .mscx or .mscz files allowed (got: $fn)");
  78                 }
  79
  80                 process($ifn, $ofn, $fn);
  81                 unlink $tfn if $tfn;
  82         }
  83 }
  84
  85 exit 0;
  86
  87 sub process
  88 {
  89         my ($ifn, $ofn, $fn) = @_;
  90
  91         my $p = XML::LibXML->new();
  92         my $doc = eval { $p->load_xml(location=>$ifn) };
  93
  94         usage("Invalid Musescore file detected (in $fn) $@") unless $doc;
  95
  96         my $version;
  97
  98         my ($muse) = $doc->findnodes('/museScore');
  99         if ($muse) {
 100                 my ($v) = $muse->findnodes('./@version');
 101                 $version = $v->to_literal if $v;
 102         }
 103         if (!$version || $version < 2) {
 104                 $version ||= "Unknown";
 105                 usage("Version $version detected in $fn, this program will only work with MuseScore 2 (or greater) files");
 106         }
 107
 108         my $of = IO::File->new(">$ofn") or usage("Cannot open $ofn $!");
 109
 110         foreach my $staff ($doc->findnodes('/museScore/Score/Staff')) {
 111                 my ($sigN, $sigD);              # current time sig values (may be needed later)
 112                 my $syllabic = 0;               # track syllabic mode (whether we are in the middle of a word in lyrics).
 113
 114                 display($staff) if $dbg;
 115
 116                 foreach my $measure ($staff->findnodes('./Measure')) {
 117                         my $lens;
 118
 119                         # obtain the measure no and any len attr. Change the len attribute
 120                         my ($l) = $measure->findnodes('./@len');
 121                         if ($l) {
 122                                 my ($t,$b) = split m{/}, $l->to_literal;
 123                                 $b *= 2;
 124                                 $lens = "$t/$b";
 125                                 $l->setValue($lens);
 126                         }
 127
 128                         # process nodes
 129                         foreach my $node ($measure->findnodes('./*')) {
 130                                 if ($node->nodeType == XML_ELEMENT_NODE) {
 131                                         my $name = $node->nodeName;
 132                                         if ($name eq 'Rest') {
 133                                                 my ($dt) = $node->findnodes('./durationType');
 134                                                 if ($dt) {
 135                                                         my $type = $dt->to_literal;
 136                                                         if ($type eq 'measure') {
 137                                                                 my ($nz) = $node->findnodes('./duration/@z');
 138                                                                 my ($nn) = $node->findnodes('./duration/@n');
 139                                                                 my $was = $nn->to_literal;
 140                                                                 my $now = $was * 2;
 141                                                                 my $z = $nz->to_literal;
 142                                                                 display($staff, $measure, $node, "$type $z/$was -> $z/$now") if $dbg;
 143                                                                 $nn->setValue($now);
 144                                                         } else {
 145                                                                 display($staff, $measure, $node, "$type -> $half{$type}") if $dbg;
 146                                                                 $dt->firstChild->setData($half{$type});
 147                                                         }
 148                                                 }
 149                                         } elsif ($name eq 'Chord') {
 150                                                 my ($dt) = $node->findnodes('./durationType');
 151                                                 if ($dt) {
 152                                                         my $type = $dt->to_literal;
 153                                                         display($staff, $measure, $node, "type $type -> $half{$type}") if $dbg;
 154                                                         $dt->firstChild->setData($half{$type});
 155                                                 }
 156                                                 my ($bm) = $node->findnodes('./BeamMode');
 157                                                 if ($bm) {
 158                                                         my $v = $bm->to_literal;
 159                                                         if ($removebeam) {
 160                                                                 display($staff, $measure, $node, "remove BeamMode '$v'") if $dbg;
 161                                                                 $node->removeChild($bm);
 162                                                         }
 163                                                 }
 164                                                 my ($lyrics) = $node->findnodes('./Lyrics');
 165                                                 if ($lyrics) {
 166                                                         my ($ticks) = $lyrics->findnodes('./ticks');
 167                                                         if ($ticks) {
 168                                                                 my $v = $ticks->to_literal;
 169                                                                 my $newv = $v / 2;
 170                                                                 display($staff, $measure, $node, $lyrics, "ticks $v -> $newv") if $dbg;
 171                                                                 $ticks->firstChild->setData($newv);
 172                                                         }
 173
 174                                                         # determine where we are in a word and if there is a <syllabic>
 175                                                         # clause, note its value (which is "in word" or "not in word")
 176                                                         #
 177                                                         # This is for dealing with musicxml imports where there is no
 178                                                         # explicit detection of trailing '-' signs, if there are such signs and
 179                                                         # there is no <syllabic> clause, add one of the correct sort and remove
 180                                                         # any trailing '-' from the text.
 181                                                         #
 182                                                         # Sadly, it's too much hard work to deal with any trailing '_' 'cos
 183                                                         # mscore calulates the distance in advance because they appear
 184                                                         # to be too lazy to have another <syllabic> state to deal with
 185                                                         # it. Manual edit will therefore be required. Hopefully, not
 186                                                         # too often.
 187                                                         my ($syl) = $lyrics->findnodes('./syllabic');
 188                                                         if ($syl) {
 189                                                                 my $v = $syl->to_literal;
 190                                                                 if ($v eq 'begin' || $v eq 'middle') {
 191                                                                         display($staff, $measure, $node, $lyrics, "syllabic $v = $syllabic -> 1") if $dbg;
 192                                                                         $syllabic = 1;
 193                                                                 } elsif ($v eq 'end') {
 194                                                                         display($staff, $measure, $node, $lyrics, "syllabic $v = $syllabic -> 0") if $dbg;
 195                                                                         $syllabic = 0;
 196                                                                 }
 197                                                         } else {
 198                                                                 my ($text) = $lyrics->findnodes('text/text()');
 199                                                                 if ($text) {
 200                                                                         my $v = $text->to_literal;
 201                                                                         my $newv;
 202                                                                         my $newstate;
 203                                                                         my $newtext = $v;
 204                                                                         if ($v =~ /[-–]$/) {
 205                                                                                 $newv = 'begin' unless $syllabic;
 206                                                                                 $newv = 'middle' if $syllabic;
 207                                                                                 $newstate = 1;
 208                                                                                 $newtext =~ s/[-–]+$//;
 209                                                                         } else {
 210                                                                                 $newv = 'end' if $syllabic;
 211                                                                                 $newstate = 0;
 212                                                                         }
 213                                                                         if ($newv) {
 214                                                                                 display($staff, $measure, $node, $lyrics, "text '$v' -> '$newtext' create syllabic $newv sylstate $syllabic -> $newstate") if $dbg;
 215                                                                                 $syllabic = $newstate;
 216                                                                                 $text->setData($newtext) if $v ne $newtext;
 217                                                                                 my $newsyl = $doc->createElement('syllabic');
 218                                                                                 $newsyl->appendText($newv);
 219                                                                                 $lyrics->appendChild($newsyl);
 220                                                                         }
 221                                                                 }
 222                                                         }
 223                                                 }
 224                                         } elsif ($name eq 'TimeSig') {
 225                                                 my ($sN) = $node->findnodes('./sigN');
 226                                                 my ($sD) = $node->findnodes('./sigD');
 227                                                 if ($sN && $sD) {
 228                                                         my $sn = $sN->to_literal;
 229                                                         my $sd = $sD->to_literal;
 230                                                         my $newsd = $sd * 2;
 231                                                         display($staff, $measure, $node, "$sn/$sd -> $sn/$newsd") if $dbg;
 232                                                         $sigN = $sd;
 233                                                         $sigD = $newsd;
 234                                                         $sD->firstChild->setData($newsd);
 235                                                 }
 236                                         }
 237                                 }
 238                         }
 239                 }
 240         }
 241
 242         print $of $doc->toString($doc);
 243         $of->close;
 244 }
 245
 246 sub display
 247 {
 248         my $s;
 249
 250         foreach my $node (@_) {
 251                 if ((ref $node) =~ /XML/ && $node->nodeType == XML_ELEMENT_NODE) {
 252                         $s .= $node->nodeName . " ";
 253                         my @attr = $node->findnodes('@*');
 254                         foreach (@attr) {
 255                                 $s .= $_->nodeName . " ";
 256                                 $s .= $_->to_literal . " ";
 257                         }
 258                 } else {
 259                         $s .= $node . " ";
 260                 }
 261         }
 262         if ($s) {
 263                 chop $s;
 264                 say $s;
 265         }
 266 }
 267
 268 sub usage
 269 {
 270         my $s = shift;
 271         my ($name, $path, $suffix) = fileparse($0, qr/\.[^.]*/);
 272         $name = "$name$suffix: ";
 273
 274         if ($s) {
 275                 say "\n${name}$s\n";
 276                 $name = "\t";
 277         }
 278         say "${name}version $VERSION usage: [-b] [-x] <filename.msc[xz]> ...\n";
 279         say "\tA program to halve the note values of a MuseScore 2.x file.\n";
 280         say "\tThis designed to be used to convert 'early music' note values";
 281         say "\tinto something more 'modern'. It will also sort out things like";
 282         say "\tinter-syllablic hyphenation if it comes across trailing hyphens";
 283         say "\tsuch as come from imported Finale musicxml files.";
 284         say "\n\tfilenames: 'a.mscz' (or 'a.mscx') will be written to 'a-halved.mscx'.";
 285         say "\tYou can do several files at a time!\n";
 286         say "\n\tArguments:";
 287         say "\t-b - normally any beaming is converted to auto, use this to retain beaming info";
 288         say "\t-x - enable debugging (actually more a stream of conscienceness)";
 289         say;
 290
 291         exit 1;
 292 }