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