--- /dev/null
+#!/usr/bin/perl
+#
+# A program for processing Musescore XML files and halving the times of all the notes
+# together with anything else that may be relevant (eg Time Sig, rests, trailing
+# '_' after lyrics etc).
+#
+# Having written this and seen that there isn't really any state preserved from
+# from one XML clause to another, it could all be done in an XSLT stylesheet. But I've
+# written it now.
+#
+# Copyright (c) Dirk Koopman 2016
+#
+
+use strict;
+use XML::LibXML;
+use File::Basename;
+use IO::File;
+
+use v5.10;
+
+our %half = ( # decode from one note length to its half
+ # there may be mispellings, as I can't be bothered
+ # to look at the code, as I use this for early music
+
+ qw(
+ long breve
+ breve whole
+ whole half
+ half quarter
+ quarter eighth
+ eighth sixteenth
+ sixteenth thirtysecond
+ thirtysecond sixtyfourth
+ )
+ );
+our %yesno = ( qw(yes 1 no 0) ); # used for turning translating yes/no text values
+
+
+our $dbg = 1; # show debugging
+our $removebeam = 1; # if set remove any BeamMode clauses
+
+usage() unless @ARGV;
+
+foreach my $fn (@ARGV) {
+ my ($name, $path, $suffix) = fileparse($fn, qr/\.[^.]*/);
+ my ($ifn, $ofn);
+ if ($suffix eq ".mscx") {
+ $ifn = $fn;
+ $ofn = $path . $name . "-halved" . $suffix;
+ } else {
+ usage();
+ }
+
+ process($ifn, $ofn);
+}
+
+exit 0;
+
+sub process
+{
+ my ($ifn, $ofn) = @_;
+
+ my $of = IO::File->new(">$ofn") or die "Cannot open $ofn $!\n";
+ my $p = XML::LibXML->new();
+ my $doc = $p->load_xml(location=>$ifn);
+
+ foreach my $staff ($doc->findnodes('/museScore/Score/Staff')) {
+ my ($sigN, $sigD); # current time sig values (may be needed later)
+ my $syllabic = 0; # track syllabic mode (whether we are in the middle of a word in lyrics).
+ display($staff) if $dbg;
+ foreach my $measure ($staff->findnodes('./Measure')) {
+
+ # process nodes
+ foreach my $node ($measure->findnodes('./*')) {
+ if ($node->nodeType == XML_ELEMENT_NODE) {
+ my $name = $node->nodeName;
+ if ($name eq 'Rest') {
+ my ($dt) = $node->findnodes('./durationType');
+ if ($dt) {
+ my $type = $dt->to_literal;
+ if ($type eq 'measure') {
+ my ($nz) = $node->findnodes('./duration/@z');
+ my ($nn) = $node->findnodes('./duration/@n');
+ my $was = $nn->to_literal;
+ my $now = $sigD || $was * 2;
+ my $z = $nz->to_literal;
+ display($staff, $measure, $node, "$type $z/$was -> $z/$now") if $dbg;
+ $nn->setValue($now);
+ } else {
+ display($staff, $measure, $node, "$type -> $half{$type}") if $dbg;
+ $dt->firstChild->setData($half{$type});
+ }
+ }
+ } elsif ($name eq 'Chord') {
+ my ($dt) = $node->findnodes('./durationType');
+ if ($dt) {
+ my $type = $dt->to_literal;
+ display($staff, $measure, $node, "type $type -> $half{$type}") if $dbg;
+ $dt->firstChild->setData($half{$type});
+ }
+ my ($bm) = $node->findnodes('./BeamMode');
+ if ($bm) {
+ my $v = $bm->to_literal;
+ if ($removebeam) {
+ display($staff, $measure, $node, "remove BeamMode '$v'") if $dbg;
+ $node->removeChild($bm);
+ }
+ }
+ my ($lyrics) = $node->findnodes('./Lyrics');
+ if ($lyrics) {
+ my ($ticks) = $lyrics->findnodes('./ticks');
+ if ($ticks) {
+ my $v = $ticks->to_literal;
+ my $newv = $v / 2;
+ display($staff, $measure, $node, $lyrics, "ticks $v -> $newv") if $dbg;
+ $ticks->firstChild->setData($newv);
+ }
+
+ # determine where we are in a word and if there is a <syllabic>
+ # clause, and it is necessary, add an appropriate one
+ #
+ # This is for dealing with musicxml imports where there is no
+ # explicit detection of trailing '-' signs, if there are and
+ # there is no <syllabic> add one of the correct sort and remove
+ # any trailing '-' from the text.
+ #
+ # Sadly, it's too much hard work to deal with trailing '_' 'cos
+ # mscore calulates the distance in advance because they appear
+ # to be too lazy to have another <syllabic> state to deal with
+ # it. Manual edit will therefore be required. Hopefully, not
+ # too often.
+ my ($syl) = $lyrics->findnodes('./syllabic');
+ if ($syl) {
+ my $v = $syl->to_literal;
+ if ($v eq 'begin' || $v eq 'middle') {
+ display($staff, $measure, $node, $lyrics, "syllabic $v = $syllabic -> 1") if $dbg;
+ $syllabic = 1;
+ } elsif ($v eq 'end') {
+ display($staff, $measure, $node, $lyrics, "syllabic $v = $syllabic -> 0") if $dbg;
+ $syllabic = 0;
+ }
+ } else {
+ my ($text) = $lyrics->findnodes('text/text()');
+ if ($text) {
+ my $v = $text->to_literal;
+ my $newv;
+ my $newstate;
+ my $newtext = $v;
+ if ($v =~ /-$/) {
+ $newv = 'begin' unless $syllabic;
+ $newv = 'middle' if $syllabic;
+ $newstate = 1;
+ $newtext =~ s/\-+$//;
+ } else {
+ $newv = 'end' if $syllabic;
+ $newstate = 0;
+ }
+ if ($newv) {
+ display($staff, $measure, $node, $lyrics, "text '$v' -> '$newtext' create syllabic $newv sylstate $syllabic -> $newstate") if $dbg;
+ $syllabic = $newstate;
+ $text->setData($newtext) if $v ne $newtext;
+ my $newsyl = $doc->createElement('syllabic');
+ $newsyl->appendText($newv);
+ $lyrics->appendChild($newsyl);
+ }
+ }
+ }
+ }
+ } elsif ($name eq 'TimeSig') {
+ my ($sN) = $node->findnodes('./sigN');
+ my ($sD) = $node->findnodes('./sigD');
+ if ($sN && $sD) {
+ my $sn = $sN->to_literal;
+ my $sd = $sD->to_literal;
+ my $newsd = $sd * 2;
+ display($staff, $measure, $node, "$sn/$sd -> $sn/$newsd") if $dbg;
+ $sigN = $sd;
+ $sigD = $newsd;
+ $sD->firstChild->setData($newsd);
+ }
+ }
+ }
+ }
+ }
+ }
+
+ print $of $doc->toString($doc);
+ $of->close;
+}
+
+sub display
+{
+ my $s;
+
+ foreach my $node (@_) {
+ if ((ref $node) =~ /XML/ && $node->nodeType == XML_ELEMENT_NODE) {
+ $s .= $node->nodeName . " ";
+ my @attr = $node->findnodes('@*');
+ foreach (@attr) {
+ $s .= $_->nodeName . " ";
+ $s .= $_->to_literal . " ";
+ }
+ } else {
+ $s .= $node . " ";
+ }
+ }
+ if ($s) {
+ chop $s;
+ say $s;
+ }
+}
+
+sub usage
+{
+ say "$0: usage <filename.mscx> ...";
+ exit 1;
+}
projects / music.git / blobdiff