#! /usr/bin/perl
#########################################################################
#        This Perl script is Copyright (c) 2011, Peter J Billam         #
#                          www.pjb.com.au                               #
#                                                                       #
#     This script is free software; you can redistribute it and/or      #
#            modify it under the same terms as Perl itself.             #
#########################################################################
my $Version       = '1.0';
my $VersionDate   = '10mar2011';
use open ':locale';

my $Port = 0;
my $Client = 20;
if ($ENV{'ALSA_OUTPUT_PORTS'}) {
	if ($ENV{'ALSA_OUTPUT_PORTS'} =~ /^(\d+):(\d+)$/) { $Client=$1 ; $Port=$2;
	} elsif ($ENV{'ALSA_OUTPUT_PORTS'} =~ /^(\d+)$/)  { $Client = $1 ;
	}
}
while ($ARGV[$[] =~ /^-([a-z])/) {
	if ($1 eq 'v')      { shift;
		my $n = $0; $n =~ s{^.*/([^/]+)$}{$1};
		print "$n version $Version $VersionDate\n";
		exit 0;
	} elsif ($1 eq 'p') { shift;
		if ($ARGV[$[] =~ /^(\d+):(\d+)$/) { $Client = $1 ; $Port = $2;
		} elsif ($ARGV[$[] =~ /^(\d+)$/)  { $Client = $1 ;
		}
		shift;
	} else {
		print "usage:\n";  my $synopsis = 0;
		while (<DATA>) {
			if (/^=head1 SYNOPSIS/)     { $synopsis = 1; next; }
			if ($synopsis && /^=head1/) { last; }
			if ($synopsis && /\S/)      { s/^\s*/   /; print $_; next; }
		}
		exit 0;
	}
}

use Data::Dumper; $Data::Dumper::Indent = 0; $Data::Dumper::Sortkeys = 1;
eval 'require MIDI'; if ($@) {
    die "you'll need to install the MIDI-Perl module from www.cpan.org\n";
}
eval 'require MIDI::ALSA'; if ($@) {
    die "you'll need to install the MIDI::ALSA module from www.cpan.org\n";
}

MIDI::ALSA::client("$0 MIDI::ALSA client", 0, 1, 1) or die "client failed";
MIDI::ALSA::connectto(0, $Client, $Port) or die "connectto failed";
MIDI::ALSA::start() or die "start failed";

my @score = file2ms_score($ARGV[$[]);
foreach my $is (1..$#score) {
	foreach my $ev_ref (@{$score[$is]}) {
		my @event = @{$ev_ref};
		# warn "event=@event\n";
		my @alsaevent = MIDI::ALSA::scoreevent2alsa(@event);
		# warn "alsaevent=@alsaevent\n";
		if (@alsaevent) { MIDI::ALSA::output(@alsaevent); }
	}
}
MIDI::ALSA::syncoutput() or die "syncoutput failed";

#-------------------- Decoding stuff from midisox_pl -------------------

sub file2opus {
	my $opus_ref;
	if ($_[$[] eq '-') {
		$opus_ref = MIDI::Opus->new({'from_handle' => *STDIN{IO}});
	} elsif ($_[$[] =~ /^[a-z]+:\//) {
		eval 'require LWP::Simple'; if ($@) {
			die "you'll need to install libwww-perl from www.cpan.org\n";
		}
		$midi = LWP::Simple::get($_[$[]);
		if (! defined $midi) { die "can't fetch $_[$[]\n"; }
		open(P, '<', \$midi) or die "can't open FileHandle, need Perl5.8\n";
		$opus_ref = MIDI::Opus->new({'from_handle' => *P{IO}});
		close P;
	} else {
		$opus_ref = MIDI::Opus->new({'from_file' => $_[$[]});
	}
	# $opus_ref->dump({'dump_tracks'=>1});
	my @my_opus = (${$opus_ref}{'ticks'},);
	foreach my $track ($opus_ref->tracks) {
		push @my_opus, $track->events_r;
	}
	# print "3:\n", Dumper(\@my_opus);
	return @my_opus;
}

sub opus2score {  my ($ticks, @opus_tracks) = @_;
	# print "opus2score: ticks=$ticks opus_tracks=@opus_tracks\n";
	if (!@opus_tracks) {
		return (1000,[],);
	}
	my @score = ($ticks,);
	#foreach my $i ($[+1 .. $#_) {
	#	push @score, MIDI::Score::events_r_to_score_r($score[$i]);
	#}
	my @tracks = deepcopy(@opus_tracks); # couple of slices probably quicker...
	# print "opus2score: tracks is ", Dumper(@tracks);
	foreach my $opus_track_ref (@tracks) {
		my $ticks_so_far = 0;
		my @score_track = ();
		my %chapitch2note_on_events = ();	# 4.4 XXX!!! Must be by Channel !!
		foreach $opus_event_ref (@{$opus_track_ref}) {
			my @opus_event = @{$opus_event_ref};
			$ticks_so_far += $opus_event[1];
			if ($opus_event[0] eq 'note_on') {
				my $cha = $opus_event[2];  # 4.4
				my $pitch = $opus_event[3];
				my $new_event_ref = ['note', $ticks_so_far, 0,
				 $cha, $pitch, $opus_event[4]];
				my $key = $cha*128 + $pitch;
				push @{$chapitch2note_on_events{$key}}, $new_event_ref;
			} elsif ($opus_event[0] eq 'note_off') {
				my $cha = $opus_event[2];
				my $pitch = $opus_event[3];
				my $key = $cha*128 + $pitch;
				if ($chapitch2note_on_events{$key}) {
					my $new_event_ref = shift @{$chapitch2note_on_events{$key}};
					${$new_event_ref}[2] = $ticks_so_far - ${$new_event_ref}[1];
					push @score_track, $new_event_ref;
				} else {
					_warn("note_off without a note_on, cha=$cha pitch=$pitch")
				}
			} else {
				$opus_event[1] = $ticks_so_far;
				push @score_track, \@opus_event;
			}
		}
		push @score, \@score_track;
	}
	# should check for unterminated notes ?
	return @score;
}

sub file2score {
	return opus2score(file2opus(midi));
}

sub file2ms_score {
	#print "file2ms_score(@_)\n";
	# return opus2score(to_millisecs(file2opus($_[$[])));
	my @opus = file2opus($_[$[]);
	my @ms = to_millisecs(@opus);
	my @score = opus2score(@ms);
	return @score;
}

#------------------------ Other Transformations ---------------------

sub to_millisecs {
	my @old_opus = @_;
	if (!@old_opus) {
		return (1000,[],);
	}
	my $old_tpq  = $_[$[];
	my @new_opus = (1000,);
	my $millisec_per_old_tick = 1000.0 / $old_tpq;  # float: will round later
	$itrack = $[+1;
	while ($itrack <= $#old_opus) {
		my $millisec_so_far = 0.0;
		my $previous_millisec_so_far = 0.0;
		my @new_track = (['set_tempo',0,1000000],);  # new "crochet" is 1 sec
		foreach my $old_event_ref (@{$old_opus[$itrack]}) {
			my @old_event = @{$old_event_ref};
			# print "to_millisecs: old_event = @old_event\n";
			if ($old_event[0] eq 'note') {
				die "to_millisecs needs an opus, not a score\n";
			}
			my @new_event = deepcopy(@old_event);  # copy.deepcopy ?
			$millisec_so_far += ($millisec_per_old_tick * $old_event[1]);
			$new_event[1] = round($millisec_so_far-$previous_millisec_so_far);
			if ($old_event[0] eq 'set_tempo') {
				$millisec_per_old_tick = $old_event[2] / (1000.0 * $old_tpq);
			} else {
				$previous_millisec_so_far = $millisec_so_far;
				push @new_track, \@new_event;
			}
		}
		push @new_opus, \@new_track;
		$itrack += 1;
	}
	# print "to_millisecs new_opus = ", Dumper(\@new_opus);
	return @new_opus;
}

sub round { my $x = $_[$[];
	if ($x > 0.0) { return int ($x + 0.5); }
	if ($x < 0.0) { return int ($x - 0.5); }
	return 0;
}

sub deepcopy {
	use Storable;
	if (1 == @_ and ref($_[$[])) {
		return Storable::dclone($_[$[]);
	} else {
		my $b_ref = Storable::dclone(\@_);
		return @$b_ref;
	}
}



__END__

=pod

=head1 NAME

apmid - example script for MIDI::ALSA; simulates aplaymidi

=head1 SYNOPSIS

 apmid filename

=head1 DESCRIPTION

This script

=head1 OPTIONS

=over 3

=item I<-d gloop>

gloops

=item I<-v>

Prints version number.

=back

=head1 CHANGES

 20110310  1.0  first working version

=head1 AUTHOR

Peter J Billam   http://www.pjb.com.au/comp/contact.html

=head1 CREDITS

Based on

=head1 SEE ALSO

 http://www.pjb.com.au/
 perl(1).

=cut

