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

our %half = (					# decode from one note length to its half
			 qw(
				   maxima long
				   long breve
				   breve whole
				   whole half
				   half quarter
				   quarter eighth
				   eighth 16th
				   16th 32nd
				   32nd 64th
				   64th 128th
				   128th 256th
				   256th 512th
				   512th 1024th
			  )
			);
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;

binmode STDOUT, "utf8";

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')) {
			my $lens;
			
			# obtain the measure no and any len attr. Change the len attribute
			my ($l) = $measure->findnodes('./@len');
			if ($l) {
				my ($t,$b) = split m{/}, $l->to_literal;
				$b *= 2;
				$lens = "$t/$b";
				$l->setValue($lens);
			}
			# 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 = $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, note its value (which is "in word" or "not in word")
							#
							# This is for dealing with musicxml imports where there is no
							# explicit detection of trailing '-' signs, if there are such signs and
							# there is no <syllabic> clause, add one of the correct sort and remove
							# any trailing '-' from the text.
							#
							# Sadly, it's too much hard work to deal with any 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;
}