#    api_for_perl.txt    -    Peter Billam 2012
#
# This bit of Perl code will wrap the CPAN MIDI module
#   http://search.cpan.org/perldoc?MIDI
# so as to present a calling-interface compatible with the Lua module
#   http://www.pjb.com.au/comp/lua/MIDI.html
# and the Python module
#   http://www.pjb.com.au/midi/MIDI.html
#
# This code is used in midisox_pl
#   http://www.pjb.com.au/midi/midisox.html
# and in midiedit
#   http://www.pjb.com.au/midi/midiedit.html
# and in midiecho
#   http://www.pjb.com.au/midi/midiecho.html
#
# The original is at
#   http://www.pjb.com.au/midi/free/api_for_perl.txt

#------------ MIDI infrastructure from midisox_pl ------------

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;
	}
}
sub vol_mul {
	my $vol = $_[$[] || 100;
	my $mul = $_[$[+1] || 1.0;
	my $new_vol = round($vol*$mul);
	if ($new_vol < 0) { $new_vol = 0 - $new_vol; }
	if ($new_vol > 127) { $new_vol = 127;
	} elsif ($new_vol < 1) { $new_vol = 1; # some synths see vol=0 as default
	}
	return $new_vol;
}

#---------------------- Encoding stuff -----------------------

sub opus2file {
	my ($filename, @opus) = @_;
	my $format = 1;
	if (2 == @opus) { $format = 0; }
	my $cpan_opus = MIDI::Opus->new(
		{'format'=>$format, 'ticks'  => 1000, 'tracks' => []});
	my @list_of_tracks = ();
	my $itrack = $[+1;
	while ($itrack <= $#opus) {
		push @list_of_tracks,
		 MIDI::Track->new({ 'type' => 'MTrk', 'events' => $opus[$itrack]});
		$itrack += 1;
	}
	$cpan_opus->tracks(@list_of_tracks);
	if ($filename eq '-') {
		$cpan_opus->write_to_file( '>-' );
	} elsif ($filename eq '-d') {
		$PID = fork;
		if (! $PID) {
			if (!open(P, '| aplaymidi -')) { die "can't run aplaymidi: $!\n"; }
			$cpan_opus->write_to_handle( *P{IO}, {} );
			close P;
			exit 0;
		}
	} else {
		$cpan_opus->write_to_file($filename);
	}
}

sub score2opus {
	if (2 > @_) { return (1000, []); }
	my ($ticks, @tracks) = @_;
	my @opus = ($ticks,);
	my $itrack = $[;
	while ($itrack <= $#tracks) {
		my %time2events = ();
		foreach my $scoreevent_ref (@{$tracks[$itrack]}) {
			my @scoreevent = @{$scoreevent_ref};
			if ($scoreevent[0] eq 'note') {
				my @note_on_event = ('note_on',$scoreevent[1],
				 $scoreevent[3],$scoreevent[4],$scoreevent[5]);
				my @note_off_event = ('note_off',$scoreevent[1]+$scoreevent[2],
				 $scoreevent[3],$scoreevent[4],$scoreevent[5]);
				if ($time2events{$note_on_event[1]}) {
				   push @{$time2events{$note_on_event[1]}}, \@note_on_event;
				} else {
				   @{$time2events{$note_on_event[1]}} = (\@note_on_event,);
				}
				if ($time2events{$note_off_event[1]}) {
				   push @{$time2events{$note_off_event[1]}}, \@note_off_event;
				} else {
				   @{$time2events{$note_off_event[1]}} = (\@note_off_event,);
				}
			} elsif ($time2events{$scoreevent[1]}) {
			   push @{$time2events{$scoreevent[1]}}, \@scoreevent;
			} else {
			   @{$time2events{$scoreevent[1]}} = (\@scoreevent,);
			}
		}

		my @sorted_events = (); # list of event_refs sorted by time
		for my $time (sort {$a <=> $b} keys %time2events) {
			push @sorted_events, @{$time2events{$time}};
		}

		my $abs_time = 0;
		for my $event_ref (@sorted_events) {  # convert abstimes => deltatimes
			my $delta_time = ${$event_ref}[1] - $abs_time;
			$abs_time = ${$event_ref}[1];
			${$event_ref}[1] = $delta_time;
		}
		push @opus, \@sorted_events;
		$itrack += 1;
	}
	return (@opus);
}

sub score2file { my ($filename, @score) = @_;
	my @opus = score2opus(@score);
	return opus2file($filename, @opus);
}

#--------------------------- Decoding stuff ------------------------

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 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' => $_[$[]});
	}
	my @my_opus = (${$opus_ref}{'ticks'},);
	foreach my $track ($opus_ref->tracks) {
		push @my_opus, $track->events_r;
	}
	return @my_opus;
}

sub opus2score {  my ($ticks, @opus_tracks) = @_;
	if (!@opus_tracks) { return (1000,[],); }
	my @score = ($ticks,);
	my @tracks = deepcopy(@opus_tracks); # couple of slices probably quicker...
	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_off'
			 or ($opus_event[0] eq 'note_on' and $opus_event[4]==0)) { # YY
				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\n");
				}
			} elsif ($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;
			} else {
				$opus_event[1] = $ticks_so_far;
				push @score_track, \@opus_event;
			}
		}
		# 4.7 check for unterminated notes, see: ~/lua/lib/MIDI.lua
		while (my ($k1,$v1) = each %chapitch2note_on_events) {
			foreach my $new_e_ref (@{$v1}) {
				${$new_e_ref}[2] = $ticks_so_far - ${$new_e_ref}[1];
				push @score_track, $new_e_ref;
				warn("opus2score: note_on with no note_off cha="
				 . ${$new_e_ref}[3] . ' pitch='
				 . ${$new_e_ref}[4] . "; adding note_off at end\n");
			}
		}
		push @score, \@score_track;
	}
	return @score;
}

sub file2score {
	return opus2score(file2opus($_[$[]));
}

sub file2ms_score {
	# return opus2score(to_millisecs(file2opus($_[$[])));
	my @opus = file2opus($_[$[]);
	my @ms = to_millisecs(@opus);
	my @score = opus2score(@ms);
	# must merge the tracks of a format-2 file; could perhaps even
	# extend the @event to indicate which Track it originated in...
	my $itrack = $#score; while ($itrack > ($[+1.5)) {
		foreach my $event_ref (@{$score[$itrack]}) {
			push @{$score[$[+1]}, $event_ref; # push them onto track 1
		}
		$itrack -= 1;
		$#score = $itrack;  # and jettison the last track
	}
	return @score;
}

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

sub to_millisecs {   # 20160702 rewrite, following MIDI.lua 6.7
	my @old_opus = @_;
	if (!@old_opus) { return (1000,[],); }
	my $old_tpq  = $old_opus[$[];
	my @new_opus = (1000,);
	# 6.7 first go through building a table of set_tempos by absolute-tick
	my %ticks2tempo = ();
	$itrack = $[+1;
	while ($itrack <= $#old_opus) {
		my $ticks_so_far = 0;
		foreach my $old_event_ref (@{$old_opus[$itrack]}) {
			my @old_event = @{$old_event_ref};
			if ($old_event[0] eq 'note') {
				die "to_millisecs needs an opus, not a score\n";
			}
			$ticks_so_far += $old_event[1];
			if ($old_event[0] eq 'set_tempo') {
				$ticks2tempo{$ticks_so_far} = $old_event[2];
			}
		}
		$itrack += 1;
	}
	# then get the sorted-array of their keys
	my @tempo_ticks = sort { $a <=> $b; } keys %ticks2tempo;
	#  then go through converting to millisec, testing if the next
	#  set_tempo lies before the next track-event, and using it if so.
	$itrack = $[+1;
	while ($itrack <= $#old_opus) {
		my $ms_per_old_tick = 1000.0 / $old_tpq;  # will round later
		my $i_tempo_ticks = 0;
		my $ticks_so_far = 0;
		my $ms_so_far = 0.0;
		my $previous_ms_so_far = 0.0;
		my @new_track = (['set_tempo',0,1000000],);  # new "crochet" is 1 sec
		foreach my $old_event_ref (@{$old_opus[$itrack]}) {
			# detect if ticks2tempo has something before this event
			# 20160702 if ticks2tempo is at the same time, leave it
			my @old_event = @{$old_event_ref};
			my $event_delta_ticks = $old_event[1];
			if ($i_tempo_ticks <= $#tempo_ticks and
			  $tempo_ticks[$i_tempo_ticks] < ($ticks_so_far+$old_event[1])) {
				my $delta_ticks = $tempo_ticks[$i_tempo_ticks]-$ticks_so_far;
				$ms_so_far += ($ms_per_old_tick * $delta_ticks);
				$ticks_so_far = $tempo_ticks[$i_tempo_ticks];
				$ms_per_old_tick=$ticks2tempo{$ticks_so_far}/(1000*$old_tpq);
				$i_tempo_ticks += 1;
				$event_delta_ticks -= $delta_ticks;
			}   # now handle the new event
			my @new_event = deepcopy(@old_event);  # copy.deepcopy ?
			$ms_so_far += ($ms_per_old_tick * $old_event[1]);
			$new_event[1] = round($ms_so_far-$previous_ms_so_far);
			if ($old_event[0] ne 'set_tempo') { # set_tempos already handled!
				$previous_ms_so_far = $ms_so_far;
				push @new_track, \@new_event;
			}
			$ticks_so_far += $event_delta_ticks;
		}
		push @new_opus, \@new_track;
		$itrack += 1;
	}
	# print "to_millisecs new_opus = ", Dumper(\@new_opus);
	return @new_opus;
}