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                 display($staff) if $dbg;
 114                 foreach my $measure ($staff->findnodes('./Measure')) {
 115                         my $lens;
 116
 117                         # obtain the measure no and any len attr. Change the len attribute
 118                         my ($l) = $measure->findnodes('./@len');
 119                         if ($l) {
 120                                 my ($t,$b) = split m{/}, $l->to_literal;
 121                                 $b *= 2;
 122                                 $lens = "$t/$b";
 123                                 $l->setValue($lens);
 124                         }
 125                         # process nodes
 126                         foreach my $node ($measure->findnodes('./*')) {
 127                                 if ($node->nodeType == XML_ELEMENT_NODE) {
 128                                         my $name = $node->nodeName;
 129                                         if ($name eq 'Rest') {
 130                                                 my ($dt) = $node->findnodes('./durationType');
 131                                                 if ($dt) {
 132                                                         my $type = $dt->to_literal;
 133                                                         if ($type eq 'measure') {
 134                                                                 my ($nz) = $node->findnodes('./duration/@z');
 135                                                                 my ($nn) = $node->findnodes('./duration/@n');
 136                                                                 my $was = $nn->to_literal;
 137                                                                 my $now = $was * 2;
 138                                                                 my $z = $nz->to_literal;
 139                                                                 display($staff, $measure, $node, "$type $z/$was -> $z/$now") if $dbg;
 140                                                                 $nn->setValue($now);
 141                                                         } else {
 142                                                                 display($staff, $measure, $node, "$type -> $half{$type}") if $dbg;
 143                                                                 $dt->firstChild->setData($half{$type});
 144                                                         }
 145                                                 }
 146                                         } elsif ($name eq 'Chord') {
 147                                                 my ($dt) = $node->findnodes('./durationType');
 148                                                 if ($dt) {
 149                                                         my $type = $dt->to_literal;
 150                                                         display($staff, $measure, $node, "type $type -> $half{$type}") if $dbg;
 151                                                         $dt->firstChild->setData($half{$type});
 152                                                 }
 153                                                 my ($bm) = $node->findnodes('./BeamMode');
 154                                                 if ($bm) {
 155                                                         my $v = $bm->to_literal;
 156                                                         if ($removebeam) {
 157                                                                 display($staff, $measure, $node, "remove BeamMode '$v'") if $dbg;
 158                                                                 $node->removeChild($bm);
 159                                                         }
 160                                                 }
 161                                                 my ($lyrics) = $node->findnodes('./Lyrics');
 162                                                 if ($lyrics) {
 163                                                         my ($ticks) = $lyrics->findnodes('./ticks');
 164                                                         if ($ticks) {
 165                                                                 my $v = $ticks->to_literal;
 166                                                                 my $newv = $v / 2;
 167                                                                 display($staff, $measure, $node, $lyrics, "ticks $v -> $newv") if $dbg;
 168                                                                 $ticks->firstChild->setData($newv);
 169                                                         }
 170
 171                                                         # determine where we are in a word and if there is a <syllabic>
 172                                                         # clause, note its value (which is "in word" or "not in word")
 173                                                         #
 174                                                         # This is for dealing with musicxml imports where there is no
 175                                                         # explicit detection of trailing '-' signs, if there are such signs and
 176                                                         # there is no <syllabic> clause, add one of the correct sort and remove
 177                                                         # any trailing '-' from the text.
 178                                                         #
 179                                                         # Sadly, it's too much hard work to deal with any trailing '_' 'cos
 180                                                         # mscore calulates the distance in advance because they appear
 181                                                         # to be too lazy to have another <syllabic> state to deal with
 182                                                         # it. Manual edit will therefore be required. Hopefully, not
 183                                                         # too often.
 184                                                         my ($syl) = $lyrics->findnodes('./syllabic');
 185                                                         if ($syl) {
 186                                                                 my $v = $syl->to_literal;
 187                                                                 if ($v eq 'begin' || $v eq 'middle') {
 188                                                                         display($staff, $measure, $node, $lyrics, "syllabic $v = $syllabic -> 1") if $dbg;
 189                                                                         $syllabic = 1;
 190                                                                 } elsif ($v eq 'end') {
 191                                                                         display($staff, $measure, $node, $lyrics, "syllabic $v = $syllabic -> 0") if $dbg;
 192                                                                         $syllabic = 0;
 193                                                                 }
 194                                                         } else {
 195                                                                 my ($text) = $lyrics->findnodes('text/text()');
 196                                                                 if ($text) {
 197                                                                         my $v = $text->to_literal;
 198                                                                         my $newv;
 199                                                                         my $newstate;
 200                                                                         my $newtext = $v;
 201                                                                         if ($v =~ /[-–]$/) {
 202                                                                                 $newv = 'begin' unless $syllabic;
 203                                                                                 $newv = 'middle' if $syllabic;
 204                                                                                 $newstate = 1;
 205                                                                                 $newtext =~ s/[-–]+$//;
 206                                                                         } else {
 207                                                                                 $newv = 'end' if $syllabic;
 208                                                                                 $newstate = 0;
 209                                                                         }
 210                                                                         if ($newv) {
 211                                                                                 display($staff, $measure, $node, $lyrics, "text '$v' -> '$newtext' create syllabic $newv sylstate $syllabic -> $newstate") if $dbg;
 212                                                                                 $syllabic = $newstate;
 213                                                                                 $text->setData($newtext) if $v ne $newtext;
 214                                                                                 my $newsyl = $doc->createElement('syllabic');
 215                                                                                 $newsyl->appendText($newv);
 216                                                                                 $lyrics->appendChild($newsyl);
 217                                                                         }
 218                                                                 }
 219                                                         }
 220                                                 }
 221                                         } elsif ($name eq 'TimeSig') {
 222                                                 my ($sN) = $node->findnodes('./sigN');
 223                                                 my ($sD) = $node->findnodes('./sigD');
 224                                                 if ($sN && $sD) {
 225                                                         my $sn = $sN->to_literal;
 226                                                         my $sd = $sD->to_literal;
 227                                                         my $newsd = $sd * 2;
 228                                                         display($staff, $measure, $node, "$sn/$sd -> $sn/$newsd") if $dbg;
 229                                                         $sigN = $sd;
 230                                                         $sigD = $newsd;
 231                                                         $sD->firstChild->setData($newsd);
 232                                                 }
 233                                         }
 234                                 }
 235                         }
 236                 }
 237         }
 238
 239         print $of $doc->toString($doc);
 240         $of->close;
 241 }
 242
 243 sub display
 244 {
 245         my $s;
 246
 247         foreach my $node (@_) {
 248                 if ((ref $node) =~ /XML/ && $node->nodeType == XML_ELEMENT_NODE) {
 249                         $s .= $node->nodeName . " ";
 250                         my @attr = $node->findnodes('@*');
 251                         foreach (@attr) {
 252                                 $s .= $_->nodeName . " ";
 253                                 $s .= $_->to_literal . " ";
 254                         }
 255                 } else {
 256                         $s .= $node . " ";
 257                 }
 258         }
 259         if ($s) {
 260                 chop $s;
 261                 say $s;
 262         }
 263 }
 264
 265 sub usage
 266 {
 267         my $s = shift;
 268         my ($name, $path, $suffix) = fileparse($0, qr/\.[^.]*/);
 269         $name = "$name$suffix: ";
 270
 271         if ($s) {
 272                 say "\n${name}$s\n";
 273                 $name = "\t";
 274         }
 275         say "${name}version $VERSION usage: [-b] [-x] <filename.msc[xz]> ...\n";
 276         say "\tA program to halve the note values of a MuseScore 2.x file.\n";
 277         say "\tThis designed to be used to convert 'early music' note values";
 278         say "\tinto something more 'modern'. It will also sort out things like";
 279         say "\tinter-syllablic hyphenation if it comes across trailing hyphens";
 280         say "\tsuch as come from imported Finale musicxml files.";
 281         say "\n\tfilenames: 'a.mscz' (or 'a.mscx') will be written to 'a-halved.mscx'.";
 282         say "\tYou can do several files at a time!\n";
 283         say "\n\tArguments:";
 284         say "\t-b - normally any beaming is converted to auto, use this to retain beaming info";
 285         say "\t-x - enable debugging (actually more a stream of conscienceness)";
 286         say;
 287
 288         exit 1;
 289 }