#!/usr/bin/env 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;

require 5.10.1;

use XML::LibXML;
use File::Basename;
use File::Temp qw{ :mktemp };
use IO::File;
use v5.10;
use utf8;

our $VERSION = "1.0";

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 = 0;					# show debugging
our $removebeam = 1;			# if set remove any BeamMode clauses

usage() unless @ARGV;

binmode STDOUT, "utf8";

foreach my $fn (@ARGV) {

	if ($fn =~ /^-\w/) {
		usage() if $fn =~ /^\-+[\?h]/i;
		$dbg ^= 1 if $fn =~ /^\-+x/;
		$removebeam ^= 1 if $fn =~ /^\-+b/;
	} else {
		my ($ifn, $ofn, $tfn);

		my ($name, $path, $suffix) = fileparse($fn, qr/\.[^.]*/);
		if ($suffix eq ".mscx" || $suffix eq ".mscz") {
			$ifn = $fn;
			$ofn = $path . $name . "-halved.mscx";

			# extract out the zipped up .mscx file from an .mscz archive
			if ($suffix eq '.mscz') {
				$tfn = mktemp("/tmp/msczXXXXXXX");
				my $xifn = $ifn;
				$xifn =~ s/z$/x/; 
				system("unzip -p $ifn $xifn > $tfn");
				$ifn = $tfn;	# the tmp file is the actual input. 
			}
		} else {
			usage("Only Musescore .mscx or .mscz files allowed (got: $fn)");
		}
		
		process($ifn, $ofn, $fn);
		unlink $tfn if $tfn;
	}
}

exit 0;

sub process
{
	my ($ifn, $ofn, $fn) = @_;

	my $p = XML::LibXML->new();
	my $doc = eval { $p->load_xml(location=>$ifn) };

	usage("Invalid Musescore file detected (in $fn) $@") unless $doc;

	my $version;
	
	my ($muse) = $doc->findnodes('/museScore');
	if ($muse) {
		my ($v) = $muse->findnodes('./@version');
		$version = $v->to_literal if $v;
	}
	if (!$version || $version < 2) {
		$version ||= "Unknown";
		usage("Version $version detected in $fn, this program will only work with MuseScore 2 (or greater) files");
	}

	my $of = IO::File->new(">$ofn") or usage("Cannot open $ofn $!");

	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
{
	my $s = shift;
	my ($name, $path, $suffix) = fileparse($0, qr/\.[^.]*/);
	$name = "$name$suffix: ";

	if ($s) {
		say "\n${name}$s\n";
		$name = "\t";
	}
	say "${name}version $VERSION usage: [-b] [-x] <filename.msc[xz]> ...\n";
	say "\tA program to halve the note values of a MuseScore 2.x file.\n";
	say "\tThis designed to be used to convert 'early music' note values";
	say "\tinto something more 'modern'. It will also sort out things like";
	say "\tinter-syllablic hyphenation if it comes across trailing hyphens";
	say "\tsuch as come from imported Finale musicxml files.";
	say "\n\tfilenames: 'a.mscz' (or 'a.mscx') will be written to 'a-halved.mscx'.";
	say "\tYou can do several files at a time!\n";
	say "\n\tArguments:";
	say "\t-b - normally any beaming is converted to auto, use this to retain beaming info";
	say "\t-x - enable debugging (actually more a stream of conscienceness)";
	say;
	
	exit 1;
}