#!/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;
}