#! /usr/bin/perl
#########################################################################
#        This Perl script is Copyright (c) 2006, Peter J Billam         #
#     c/o P J B Computing, GPO Box 669, Hobart TAS 7001, Australia      #
#                                                                       #
#     This script is free software; you can redistribute it and/or      #
#            modify it under the same terms as Perl itself.             #
#########################################################################
# Simulates (very roughly) a tape-delay echo on particular MIDI-channels
# by issuing repeated note_on events with diminishing volume.  YMMV!
#
# We have to work in MIDI::Event, because we may (if no -N) need to
# produce one note_off for multiple note_on's ...

eval 'require MIDI'; if ($@) {
	die "you'll need to install the MIDI::Perl module from www.cpan.org\n";
}
import MIDI;
my $Version      = '1.9';   # fixed 2 bugs; numerical sort of keys of %pending
                    # and start_time remembers $millisecs, not $unique_ms
my $VersionDate  = '6oct2007';
my %Channel      = ('0',1); # MIDI channel on which the echoes will be added
my %EchoNotes    = ();      # MIDI notes to which the echoes will be added
my @Delays       = (300);   # incremental milliseconds of the various delays
my @Echoes       = ();      # the channels that the echoes will be sent to
my @PitchChanges = (0);     # the pitch-changes of the various channels
my %pitch_change = ();
my @Quietenings  = (25);    # decremental velocites (loudness) of the echoes
my $Nesting = 1;    # the synth keeps count of nesting note_ons on each note
my %nesting;        # $nesting{$cha}{$note} = number of nested output note_ons
my @newevents;      # LoL of output events
my $Debug   = 0;

# check format of options args...
while ($ARGV[$[] =~ /^-(\w)/) {
	if ($1 eq 'c')      { shift; %Channel = ();
		my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -c arg: $a\n"; }
		foreach (split (',', $a)) { $Channel{$_} = 1; }
	} elsif ($1 eq 'd') { shift;
		my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -d arg: $a\n"; }
		@Delays      = sort split (',', $a);
	} elsif ($1 eq 'e') { shift;
		my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -e arg: $a\n"; }
		@Echoes      = split (',', $a);
	} elsif ($1 eq 'p') { shift;
		my $a = shift; if ($a !~ /^[-\d,]*$/)  { die "bad -p arg: $a\n"; }
		@PitchChanges = split (',', $a);
	} elsif ($1 eq 'q') { shift;
		my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -q arg: $a\n"; }
		@Quietenings = split (',', $a);
	} elsif ($1 eq 'n') { shift;
		my $a = shift; if ($a !~ /^\d[\d,]*$/) { die "bad -n arg: $a\n"; }
		shift; foreach (split (',', $a)) { $EchoNotes{$_} = 1; }
	} elsif ($1 eq 'N') { shift; $Nesting     = 1;  # now the default
	} elsif ($1 eq 'S') { shift; $Nesting     = 0;
	} elsif ($1 eq 'D') { shift; $Debug       = 1;
	} else {
my $n = $0; $n =~ s#^.*/([^/]+)$#$1#;
print <<EOT; exit 0;
Usage:
   $n filename                # defaults: $n -c 0 -d 300 -q 30
   $n -c 3 fn                 # Echoes on midi Channel 3
   $n -c 9 -n 38,40 fn        # echo on the General-Midi snare drums
   $n -c 3 -d 450,700,1050 fn # Delayed notes are at 450,700 & 1050 mS
   $n -c 3 -d 250,400 -q 30,20 fn # and are (MIDI) 30 and 50 Quieter
   $n -c 3 -d 300,500 -e 4,5 fn  # Echoes are sent to channels 4 and 5
   $n -c 3 -d 40 -e 4 -p 10 -q 0 # Automatic-Double-Tracking
   $n -c 1 -d 350 -q 35 -S fn # Stateless synth doesn't count note_ons
   perldoc $n                 # read the real Documentation !
Version $Version  $VersionDate  http://www.pjb.com.au/midi
EOT
	}
}

my $opus = MIDI::Opus->new({ 'from_file' => $ARGV[$[] || '-'});
my $TPQ = $opus->ticks() || 96; # MIDI Ticks Per Crochet
my $newopus;
my $dt_backlog = 0; # if a note_off is suppressed, we remember its ticks

# pre-extend @Quietenings @Echoes and $PitchChanges to same length as @Delays
my $i=$[; while (1) {
	last if ($i > $#Delays);
	if ($Delays[$i] < 1) { $Delays[$i] = 1; } # 1.6; delay=0 causes midi chaos
	$i++;
}
$i=$[+1; while (1) {
	if (!defined $Quietenings[$i]) { $Quietenings[$i] = $Quietenings[$i-1]; }
	last if ($i > $#Delays); $i++;
}
if (@Echoes) {
	my $i=$[+1; while (1) {
		if (!defined $Echoes[$i]) { $Echoes[$i] = $Echoes[$i-1]; }
		last if ($i > $#Delays); $i++;
	}
}
if (@PitchChanges) {
	my $i=$[; while (1) {
		last if ($i > $#PitchChanges);
		if ($PitchChanges[$i]) {
			$pitch_change{$Echoes[$i]} = int (40.96 * $PitchChanges[$i]);
		}
		$i++;
	}
}

foreach my $track ($opus->tracks()) {  # there will usually be only one
	my $events_r = $track->events_r();

	my $millisecs = 0.0;  # elapsed time
	my %start_time; # @{$start_time{$cha}{$note}} = ($millisecs1,$millisecs2..)
	my %pending;    # note_on and note_off events which haven't yet
	                # been output to @$newevents
	                # HoL $pending{$millisecs} = [$evtype,$cha,$note,$vol]
	                # with millisecs uniquised by adding hundredths as needed.
	my %unfinished; # note_on events which don't yet have a corresponding
	                # note_off, because the dry note hasn't finished yet.
	                # $unfinished{$millisecs}=['note_on',$echo_cha,$note,$vol]
	my %started_by; # the channel that started the note_on event in unfinished
	                # $started_by{$millisecs} = $dry_cha;
	my $miditempo = 1000000; # default cro=60
	@newevents    = ();
	%nesting      = ();
	$dt_backlog   = 0;

	foreach my $channel (keys %pitch_change) {
		push @newevents,
		 ['pitch_wheel_change',0,$channel,$pitch_change{$channel}];
	}

	foreach my $event (@{$events_r}) {
		# these varnames are only accurate for note_on and note_off events:
		my ($evtype, $dticks, $cha, $note, $vol) = @$event;
		my $dmillisecs = $dticks * $miditempo * 0.001 / $TPQ;
		$millisecs += $dmillisecs;
		if ($Debug) {
			printf STDERR "\nEVENT %s dticks=%g dmillisecs=%g millisecs=%g",
			$evtype,$dticks,$dmillisecs,$millisecs;
		}

		# Go through all remembered echo note_on and echo note_off events;
		# those that are now overdue, work out how many ticks before $event,
		# set their dtimes, push them onto @newevents, forget them,
		# and reduce ${$event}[$[+1] accordingly
		# We also do something like this on loop-exit ...
		my $burned_ticks = 0;
		# these are the delayed echos
		foreach my $t (sort {$a<=>$b} keys %pending) {
			if ($t > $millisecs) { last; }
			my ($evtype,$cha,$note,$vol) = @{$pending{$t}};
			if ($Debug) {
				printf STDERR "\n reviewing pending t=%g", $t;
				print STDERR " evtype=$evtype cha=$cha note=$note";
			}
			my $ticksbeforenow = ($millisecs-$t) * $TPQ / ($miditempo * 0.001);
			my $dt = $dticks - $ticksbeforenow;
			if ($dt < 0) { $dt = 0; }
			$dt = int (0.5 + $dt);
			delete $pending{$t}; # NB difference between pending and unfinished
			$dticks -= $dt;
			$burned_ticks += $dt;
			if ($evtype eq 'note_off')    { &note_off($dt, $cha, $note, $vol);
			} elsif ($evtype eq 'note_on') { &note_on($dt, $cha, $note, $vol);
			}
		}

		if ($evtype eq 'note_on') {  # this is a dry-note_on, not an echo
			# if channel OK, remember this note has started and not yet finished
			my $unique_ms;
			if ($Channel{$cha} && (!%EchoNotes || $EchoNotes{$note})) {
				my $quietenedvol = $vol;
				my $i = $[; foreach (@Delays) {
					$unique_ms = $millisecs+$_;
					while ($pending{$unique_ms}) { $unique_ms += 0.01; }
					$quietenedvol -= $Quietenings[$i];
					if ($quietenedvol < 1) { $dt_backlog += $dticks; next; }
					my $echocha; if (defined $Echoes[$i]) {
						$echocha = $Echoes[$i];
					} else { $echocha = $cha;
					}
					$pending{$unique_ms} =
					 [$evtype,$echocha,$note,$quietenedvol];
					$unfinished{$unique_ms} =
					 [$evtype,$echocha,$note,$quietenedvol];
					$started_by{$unique_ms}=$cha;
					if ($Debug) {
						printf STDERR "\n new unfinished{%g}",$unique_ms;
						print STDERR "=[$evtype,$echocha,$note,$quietenedvol]";
						printf STDERR "\n new pending{%g}",$unique_ms;
						print STDERR "=[$evtype,$echocha,$note,$quietenedvol]";
					}
					$i++;
				}
			}
			&note_on($dticks,$cha,$note,$vol);
			push @{$start_time{$cha}{$note}}, $millisecs;
			if ($Debug) {
				printf STDERR "\n new start_time{$cha}{$note}=%g",$millisecs;
				print STDERR "\n list of start_times{$cha}{$note} is:";
				foreach (@{$start_time{$cha}{$note}}) {
					printf STDERR " %g",$_;
				}
			}
		} elsif ($evtype eq 'note_off') { # a dry-note_off, not echo note_off
			if ($Debug) {
				print STDERR "\n It's a note_off cha=$cha note=$note vol=$vol";
			}
			my %unfinished_on_this_note;
			if (@{$start_time{$cha}{$note}}) {
				# calculate intended note-duration, and remember for the echoes
				my $start_time=shift @{$start_time{$cha}{$note}}; #NO,not dry!
				my $duration = $millisecs - $start_time;
				if ($Debug) {
					printf STDERR " start_time=%g duration=%g",
					 $start_time, $duration;
					print STDERR
					 "\n after shift, list of start_times{$cha}{$note} is:";
					foreach (@{$start_time{$cha}{$note}}) {
						printf STDERR " %g",$_;
					}
				}

				%unfinished_on_this_note = ();
				foreach my $t (sort keys %unfinished) {
					if ($Debug) { printf STDERR "\n unfinished{%g}",$t; }
					my ($u_ev,$u_cha,$u_note,$u_vol) = @{$unfinished{$t}};
					if ($Debug) {
						print STDERR " u_ev=$u_ev u_cha=$u_cha";
						print STDERR " u_note=$u_note u_vol=$u_vol";
						print STDERR " started_by=$started_by{$t}";
					}
					if($u_ev eq 'note_on' && $started_by{$t} eq $cha
					 && $u_note eq $note){
						$unfinished_on_this_note{$t} =
						 [$u_ev,$u_cha,$u_note,$u_vol];
						if ($Debug) {
							printf STDERR "\n unfinished_on_this_note{%g} $u_ev",$t;
						}
					}
				}
				# find the first `scalar @Delays` unfinished note_ons on this
				# note and put into %pending the corresponding note_off events:
				my $i = 1; my $n = scalar @Delays;
				foreach my $t (sort keys %unfinished_on_this_note) {
					last if $i > $n;
					my $unique_ms = $t + $duration;
					if ($Debug) {
						printf STDERR "\n t=%g duration=$duration", $t, $duration;
					}
					while ($pending{$unique_ms}) { $unique_ms += 0.01; }
					my $echocha = ${$unfinished_on_this_note{$t}}[$[+1];
					$pending{$unique_ms} = ['note_off', $echocha, $note, $vol];
					delete $unfinished{$t};
					delete $started_by{$t};
					if ($Debug) {
						printf STDERR "\n new pending{%g}", $unique_ms;
						print STDERR "=[note_off,$echocha,$note,$vol]";
					}
					$i++;
				}
				&note_off($dticks,$cha,$note,$vol);
			} else {
				if ($Channel{$cha} && $Debug) {
					print STDERR "\n note_off without note :-( cha=$cha note=$note";
				} else {
					&note_off($dticks,$cha,$note,$vol);
				}
			}
		} else {
			if ($evtype eq 'set_tempo') { $miditempo = ${$event}[$[+2]; }
			${$event}[$[+1] -= ($burned_ticks-$dt_backlog);
			push @newevents, $event;
			if ($Channel{$cha} && $evtype eq 'pitch_wheel_change') {
				my $i = $[; foreach (@Delays) {
					my $echocha; if (defined $Echoes[$i]) {
						$echocha = $Echoes[$i];
					} else { $echocha = $cha;
					}
					if ($pitch_change{$echocha}) {
						push @newevents, [ 'pitch_wheel_change', 0, $echocha,
					 	${$event}[$[+3] + $pitch_change{$echocha} ];
					}
					$i++;
				}
			}
			$dt_backlog = 0;
		}
		if ($Debug) { print STDERR "\n"; }
	}
	# output remaining pending events, the final echoes...
	foreach my $t (sort keys %pending) {
		my ($evtype,$cha,$note,$vol) = @{$pending{$t}};
		my $ticksafternow = ($t-$millisecs) * $TPQ / ($miditempo * 0.001);
		my $dt = $ticksafternow;
		if ($dt < 0) { $dt = 0; }
		$dt = int (0.5 + $dt);
		if ($Debug) {
			printf STDERR "\nREMAINING: t=%g evtype=$evtype cha=$cha note=$note", $t;
			printf STDERR " ticksafternow=%g dt=$dt",$ticksafternow;
		}
		if ($evtype eq 'note_on') {       &note_on($dt, $cha, $note, $vol);
		} elsif ($evtype eq 'note_off') { &note_off($dt, $cha, $note, $vol);
		} else { push @newevents, [$evtype, $dt, $cha, $note, $vol];
		}
		$millisecs = $t;  # ? kddp ?
	}

	# this bit copied from muscript:
	my $newtrack = MIDI::Track->new( {'events'=>\@newevents} );
	if (!$newtrack) { die "MIDI::Track->new failed\n"; }
	$newopus = MIDI::Opus->new(
	 {'format'=>0,'ticks'=>$TPQ,'tracks'=>[$newtrack]} );
	if (!$newopus) { die "MIDI::Opus->new failed\n"; }

}
if ($Debug) {print STDERR "\n",'-'x60,"\n";$newopus->dump({'dump_tracks'=>1});exit;}
$newopus->write_to_file( '>-' );

# ------------------------- infrastructure -----------------------------

sub note_on { my ($dt, $cha, $note, $vol) = @_;
	if (! $note) { die "Bug: note_on called with dt=$dt cha=$cha note=0\n"; }
	if ($Debug) {
		printf STDERR "\n sub note_on dt=%g cha=$cha note=$note vol=$vol", $dt;
	}
	push @newevents, ['note_on', $dt+$dt_backlog, $cha, $note, $vol];
	$dt_backlog = 0;
	if ($Channel{$cha} && (!%EchoNotes || $EchoNotes{$note})) {
		$nesting{$cha}{$note} ++;
	}
}
sub note_off { my ($dt, $cha, $note, $vol) = @_;
	if (!$note) { die "Bug: note_off called with dt=$dt cha=$cha note=0\n"; }
	if ($Debug) {
		print STDERR "\n sub note_off: dt=$dt cha=$cha note=$note vol=$vol";
		print " nesting=$nesting{$cha}{$note} dt_backlog=$dt_backlog";
		print " Nesting=$Nesting";
	}
	if ($Channel{$cha} && (!%EchoNotes || $EchoNotes{$note})) {
		if ($nesting{$cha}{$note} < 1.5) {
			push @newevents, ['note_off', $dt+$dt_backlog, $cha, $note, $vol];
			$nesting{$cha}{$note} = 0;
			# delete $start_time{$cha}{$note};
			$dt_backlog = 0;
		} else {
			$nesting{$cha}{$note} --;
			if ($Nesting) {
				push @newevents, ['note_off', $dt+$dt_backlog,$cha,$note,$vol];
				$dt_backlog = 0;
			} else { 
				$dt_backlog += $dt;
			}
			if ($Debug) {
				print STDERR "\n after decrementing, nesting=$nesting{$cha}{$note}";
			}
		}
	} else {
		push @newevents, ['note_off', $dt+$dt_backlog, $cha, $note, $vol];
		$dt_backlog = 0;
	}
}

__END__

=pod

=head1 NAME

midiecho - Simulates the old tape-loop delay echo on MIDI files

=head1 SYNOPSIS

 midiecho -c 3 fn            # echo will be added to midi Channel 3
 midiecho -c 3 -d 450,900,1350 fn  # Echoes at 450, 900 and 1350 mS
 midiecho -c 3 -d 450,900 -q 30 fn # each echo is (MIDI) 30 Quieter
 midiecho -c 2 -d 450 -e 5 -q 30 fn # the Echo appears on channel 5
 midiecho -c 3 -e 4 -d 40 -p 10 -q 0    # Automatic-Double-Tracking
 midiecho -c 1 -d 350 -q 35 -S # Stateless synth doesn't count note_ons
 midiecho filename          #  defaults: midiecho -c 0 -d 300 -q 30
 muscript -midi f.txt | midiecho -c 1 -d 300 -q 25 -e 2 - > f.mid

=head1 DESCRIPTION

Simulates (roughly) a tape-delay echo on a particular MIDI-channel
by issuing repeated note_on events with diminishing volume.
It does about as well as can be done at the MIDI-level,
and how well that works on your particular sounds is for you to decide.
YMMV!

Midiecho sounds best if the -e option is used, to assign the
echoes to different MIDI-channels; this avoids notes being
restarted before they have finished.

If the -e option is not being used,
then the echo note is played on the same channel as the original note.
If this leaves your synth chopping of lots of notes
(when the original note is not finished by the time the echo note starts),
then your synth is probably stateless, 
and you should try invoking midiecho with the -S option.
Without -e, midiecho works much better on transient sounds,
e.g. banjo, or snare-drum.

The -p option allows the echo to be detuned (in 1/100's of a semitone)
which makes possible an "Automatic Double-Tracking" effect.

This is version 1.8

=head1 OPTIONS

=over 3

=item I<-c 3>

Echo will be added to midi B<C>hannel 3.  The channels are numbered
from 0...15 If -c is not specified, the default channel is 0.
Midiecho can only add echoes to one channel at once;
the other channels pass through unaltered.

=item I<-d 350,650,900>

The echo notes will be B<D>elayed 350, 650 and 900 mS after the original
note.  If -d is not specified, the default delay is just 300 mS

=item I<-e 4,5,4>

The B<E>choes are produced not on the original (-c) channel
but on the channels 4 then 5 then 4 again
(in this example there are three echoes).
This is a really useful option :-)

As one example usage, you might have set up your synth's channel 4 and 5
with the same patch (instrumental sound) as the original channel (e.g. 3),
but panned to different places in the stereo image.
This creates a very realistic echo-effect.

Another example usage could be to set up the echo-channels with a
completely different sound, maybe something atmospheric or ethereal.

Another example usage could be to set up the echo-channels
with a different patch, and use a 1ms delay, thus doubling
the original channel with a different sound.

If the number of echo-channels (-e) is fewer than the number of delays
in the -d list, then the last echo-channel is repeated as necessary.

=item I<-n 38,40>

Echo will be added only to midi B<N>otes 38 and 40.
This option is mainly useful with General-MIDI channel 9,
which represents a drumkit, with each note representing a different drum,
see http://www.pjb.com.au/muscript/gm.html#perc

In this I<-c 9 -n 38,40> example, echoes would only be added to
the Acoustic Snare and the Electric Snare sounds.

=item I<-p 8>

The echo will be B<P>itch-changed up 8 cents (hundredth's of a semitone).
This is mainly useful in conjunction with the B<-e>, B<-d> and B<-q>
options to produce the "Automatic-Double-Tracking" effect, e.g.
 midiecho -c 3 -e 4 -d 40 -p -10 -q 0

which assumes that the original channel 3 is panned over to one extreme,
and the echo-channel 4 is set up with the same patch but panned over
the other way.  It then produces an "echo" of the same volume and just
40mS late and just 10 cents lower. Because the two sounds are in
different speakers they don't beat with each other, and sound almost
like two instruments playing in unison.

=item I<-q 35,20>

The first delayed note is 35 (MIDI) B<Q>uieter than the original,
and the second is 20 quieter still.

If the number of quietenings (-e) is fewer than the number of delays
in the -d list, then the last quietening is repeated as necessary.

If an echo ends up with zero volume or less, then it is suppressed.

If -q is not specified, by default each echo is 30 quieter
than the previous.

=item I<-S>

You'll need to use the -S option if you're not using -e,
and if the sythesiser you're going to be using is B<S>tateless.
In other words, if the sythesiser does not keep a count
of how many note_on's there have been on a given note,
and switches the note off if receives even just one note_off command.
So if your synth seems to be chopping off lots of notes,
you should try invoking midiecho with the -S option.

=item I<-N>

This option is now defunct; it's the opposite of -S, and is now
the default behaviour.  It fits the behaviour of MIDI-Perl,
timidity, and the Roland XV-2020, among others.

=back

=head1 AUTHOR

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

=head1 CREDITS

Based on Sean Burke's MIDI::Perl CPAN module.

=head1 SEE ALSO

 http://search.cpan.org/~sburke
 http://www.pjb.com.au/muscript
 http://www.pjb.com.au/midi

=cut