mscore-halve

   1 #!/usr/bin/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 use XML::LibXML;
  16 use File::Basename;
  17 use IO::File;
  18 use v5.10;
  19 use utf8;
  20
  21 our %half = (                                   # decode from one note length to its half
  22                          qw(
  23                                    maxima long
  24                                    long breve
  25                                    breve whole
  26                                    whole half
  27                                    half quarter
  28                                    quarter eighth
  29                                    eighth 16th
  30                                    16th 32nd
  31                                    32nd 64th
  32                                    64th 128th
  33                                    128th 256th
  34                                    256th 512th
  35                                    512th 1024th
  36                           )
  37                         );
  38 our %yesno = ( qw(yes 1 no 0) ); # used for turning translating yes/no text values
  39
  40
  41 our $dbg = 1;                                   # show debugging
  42 our $removebeam = 1;                    # if set remove any BeamMode clauses
  43
  44 usage() unless @ARGV;
  45
  46 binmode STDOUT, "utf8";
  47
  48 foreach my $fn (@ARGV) {
  49         my ($name, $path, $suffix) = fileparse($fn, qr/\.[^.]*/);
  50         my ($ifn, $ofn);
  51         if ($suffix eq ".mscx") {
  52                 $ifn = $fn;
  53                 $ofn = $path . $name . "-halved" . $suffix;
  54         } else {
  55                 usage();
  56         }
  57
  58         process($ifn, $ofn);
  59 }
  60
  61 exit 0;
  62
  63 sub process
  64 {
  65         my ($ifn, $ofn) = @_;
  66
  67         my $of = IO::File->new(">$ofn") or die "Cannot open $ofn $!\n";
  68         my $p = XML::LibXML->new();
  69         my $doc = $p->load_xml(location=>$ifn);
  70
  71         foreach my $staff ($doc->findnodes('/museScore/Score/Staff')) {
  72                 my ($sigN, $sigD);              # current time sig values (may be needed later)
  73                 my $syllabic = 0;               # track syllabic mode (whether we are in the middle of a word in lyrics).
  74                 display($staff) if $dbg;
  75                 foreach my $measure ($staff->findnodes('./Measure')) {
  76                         my $lens;
  77
  78                         # obtain the measure no and any len attr. Change the len attribute
  79                         my ($l) = $measure->findnodes('./@len');
  80                         if ($l) {
  81                                 my ($t,$b) = split m{/}, $l->to_literal;
  82                                 $b *= 2;
  83                                 $lens = "$t/$b";
  84                                 $l->setValue($lens);
  85                         }
  86                         # process nodes
  87                         foreach my $node ($measure->findnodes('./*')) {
  88                                 if ($node->nodeType == XML_ELEMENT_NODE) {
  89                                         my $name = $node->nodeName;
  90                                         if ($name eq 'Rest') {
  91                                                 my ($dt) = $node->findnodes('./durationType');
  92                                                 if ($dt) {
  93                                                         my $type = $dt->to_literal;
  94                                                         if ($type eq 'measure') {
  95                                                                 my ($nz) = $node->findnodes('./duration/@z');
  96                                                                 my ($nn) = $node->findnodes('./duration/@n');
  97                                                                 my $was = $nn->to_literal;
  98                                                                 my $now = $was * 2;
  99                                                                 my $z = $nz->to_literal;
 100                                                                 display($staff, $measure, $node, "$type $z/$was -> $z/$now") if $dbg;
 101                                                                 $nn->setValue($now);
 102                                                         } else {
 103                                                                 display($staff, $measure, $node, "$type -> $half{$type}") if $dbg;
 104                                                                 $dt->firstChild->setData($half{$type});
 105                                                         }
 106                                                 }
 107                                         } elsif ($name eq 'Chord') {
 108                                                 my ($dt) = $node->findnodes('./durationType');
 109                                                 if ($dt) {
 110                                                         my $type = $dt->to_literal;
 111                                                         display($staff, $measure, $node, "type $type -> $half{$type}") if $dbg;
 112                                                         $dt->firstChild->setData($half{$type});
 113                                                 }
 114                                                 my ($bm) = $node->findnodes('./BeamMode');
 115                                                 if ($bm) {
 116                                                         my $v = $bm->to_literal;
 117                                                         if ($removebeam) {
 118                                                                 display($staff, $measure, $node, "remove BeamMode '$v'") if $dbg;
 119                                                                 $node->removeChild($bm);
 120                                                         }
 121                                                 }
 122                                                 my ($lyrics) = $node->findnodes('./Lyrics');
 123                                                 if ($lyrics) {
 124                                                         my ($ticks) = $lyrics->findnodes('./ticks');
 125                                                         if ($ticks) {
 126                                                                 my $v = $ticks->to_literal;
 127                                                                 my $newv = $v / 2;
 128                                                                 display($staff, $measure, $node, $lyrics, "ticks $v -> $newv") if $dbg;
 129                                                                 $ticks->firstChild->setData($newv);
 130                                                         }
 131
 132                                                         # determine where we are in a word and if there is a <syllabic>
 133                                                         # clause, note its value (which is "in word" or "not in word")
 134                                                         #
 135                                                         # This is for dealing with musicxml imports where there is no
 136                                                         # explicit detection of trailing '-' signs, if there are such signs and
 137                                                         # there is no <syllabic> clause, add one of the correct sort and remove
 138                                                         # any trailing '-' from the text.
 139                                                         #
 140                                                         # Sadly, it's too much hard work to deal with any trailing '_' 'cos
 141                                                         # mscore calulates the distance in advance because they appear
 142                                                         # to be too lazy to have another <syllabic> state to deal with
 143                                                         # it. Manual edit will therefore be required. Hopefully, not
 144                                                         # too often.
 145                                                         my ($syl) = $lyrics->findnodes('./syllabic');
 146                                                         if ($syl) {
 147                                                                 my $v = $syl->to_literal;
 148                                                                 if ($v eq 'begin' || $v eq 'middle') {
 149                                                                         display($staff, $measure, $node, $lyrics, "syllabic $v = $syllabic -> 1") if $dbg;
 150                                                                         $syllabic = 1;
 151                                                                 } elsif ($v eq 'end') {
 152                                                                         display($staff, $measure, $node, $lyrics, "syllabic $v = $syllabic -> 0") if $dbg;
 153                                                                         $syllabic = 0;
 154                                                                 }
 155                                                         } else {
 156                                                                 my ($text) = $lyrics->findnodes('text/text()');
 157                                                                 if ($text) {
 158                                                                         my $v = $text->to_literal;
 159                                                                         my $newv;
 160                                                                         my $newstate;
 161                                                                         my $newtext = $v;
 162                                                                         if ($v =~ /[-–]$/) {
 163                                                                                 $newv = 'begin' unless $syllabic;
 164                                                                                 $newv = 'middle' if $syllabic;
 165                                                                                 $newstate = 1;
 166                                                                                 $newtext =~ s/[-–]+$//;
 167                                                                         } else {
 168                                                                                 $newv = 'end' if $syllabic;
 169                                                                                 $newstate = 0;
 170                                                                         }
 171                                                                         if ($newv) {
 172                                                                                 display($staff, $measure, $node, $lyrics, "text '$v' -> '$newtext' create syllabic $newv sylstate $syllabic -> $newstate") if $dbg;
 173                                                                                 $syllabic = $newstate;
 174                                                                                 $text->setData($newtext) if $v ne $newtext;
 175                                                                                 my $newsyl = $doc->createElement('syllabic');
 176                                                                                 $newsyl->appendText($newv);
 177                                                                                 $lyrics->appendChild($newsyl);
 178                                                                         }
 179                                                                 }
 180                                                         }
 181                                                 }
 182                                         } elsif ($name eq 'TimeSig') {
 183                                                 my ($sN) = $node->findnodes('./sigN');
 184                                                 my ($sD) = $node->findnodes('./sigD');
 185                                                 if ($sN && $sD) {
 186                                                         my $sn = $sN->to_literal;
 187                                                         my $sd = $sD->to_literal;
 188                                                         my $newsd = $sd * 2;
 189                                                         display($staff, $measure, $node, "$sn/$sd -> $sn/$newsd") if $dbg;
 190                                                         $sigN = $sd;
 191                                                         $sigD = $newsd;
 192                                                         $sD->firstChild->setData($newsd);
 193                                                 }
 194                                         }
 195                                 }
 196                         }
 197                 }
 198         }
 199
 200         print $of $doc->toString($doc);
 201         $of->close;
 202 }
 203
 204 sub display
 205 {
 206         my $s;
 207
 208         foreach my $node (@_) {
 209                 if ((ref $node) =~ /XML/ && $node->nodeType == XML_ELEMENT_NODE) {
 210                         $s .= $node->nodeName . " ";
 211                         my @attr = $node->findnodes('@*');
 212                         foreach (@attr) {
 213                                 $s .= $_->nodeName . " ";
 214                                 $s .= $_->to_literal . " ";
 215                         }
 216                 } else {
 217                         $s .= $node . " ";
 218                 }
 219         }
 220         if ($s) {
 221                 chop $s;
 222                 say $s;
 223         }
 224 }
 225
 226 sub usage
 227 {
 228         say "$0: usage <filename.mscx> ...";
 229         exit 1;
 230 }