#! /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 a particular MIDI-channel
# or, since 2.0. on real-time MIDI,
# 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 ...
#
# 20100316 must add rawmidi; same options, but little code in common
#  from delay    - child must binary-insert future events into a list
#  from midikbd  - the -p option and the aconnect stuff
#  from midiecho - the options; need also input-port and possibly output-port
# delays in secs more appropriate than in millisecs ?

use bytes;

my $Version      = '2.4';   # bug fixed with pitch-bend events
my $VersionDate  = '20apr2010';
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 %DoEchoCC     = map { $_, 1 }  (1,5,11,64,65,66,84);
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;
my $RealTimeMode = 0;
my $InputPort  = q{};
my $OutputPort = q{};
my $OFH;
my $Zero_secs;


# 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 'i') { shift; $RealTimeMode = 1; $InputPort = shift;
	} elsif ($1 eq 'o') { shift; $OutputPort = shift;
	} 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;
Version $Version  $VersionDate  http://www.pjb.com.au/midi
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
   $n -i 120:0 -o 20:0        # Real-Time MIDI! alsaport 120 into 20
   $n -i 120:0                # Real-Time MIDI! into ALSA_OPTPUT_PORTS
   perldoc $n                 # read the real Documentation !

   # on real-time (raw) midi :
   midiecho -i 22:0 -o 128:0 -c 3 -d 450,900  # from ALSAport 22 to 128

EOT
	}
}

# 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++;
	}
}

if ($RealTimeMode) {
	eval "require Time::HiRes"; if ($@) {
		die "you need to install the Time::HiRes module from www.cpan.org\n";
	}
	($Zero_secs, $usecs) = Time::HiRes::gettimeofday();

	my $device; $a = $OutputPort;  # OFH is used by both parent and child
	my $end_eval_code;
	# BUT this alsaport2device call must not be forked (END runs twice!)
	if ($a =~ /^$|^\d+(:\d)?$/)  {
		($device,$end_eval_code) = alsaport2device($a, 'out');
	} elsif ($a =~ /^midiC/)  { $device = "/dev/snd/$a";
	} elsif ($a =~ /^midi\d/) { $device = "/dev/$a";
	} elsif ($a eq '-')       { $OFH = *STDOUT;
	} else { die "bad -o arg: $a\n";
	}
	if (!$OFH and !open $OFH, ">$device") { die "can't open $device: $!\n"; }
	select $OFH; $| = 1; select STDOUT;

	my @PIPES;
	foreach my $i ($[ .. $#Delays) {
		# see perldoc perlfork,  3/4 way through, "Forking pipe open"
		# The following example shows how to write to a forked child:
		pipe my $child, $PIPES[$i] or die "can't pipe: $!\n";;
		my $pid = fork();
		die "fork() failed: $!" unless defined $pid;
		my $pipe = $PIPES[$i];  # must be a scalar to work in open and close
		if ($pid) {  # parent establishes a pipe to the child
			close $child;

	    	select $pipe; $|=1; select STDOUT;
			next;  # spawn next child ...
		} else {  # child
			close $pipe;
			open(STDIN, "<&=", fileno($child)) or die;
	    	while (1) {
	        	read STDIN,my $usecs,16 or last;
	        	read STDIN,my $length,6 or last;
	        	read STDIN,my $event,0+$length or last;
	        	my $now = usecs();
	        	if ($usecs>$now) { Time::HiRes::usleep($usecs-$now); }
				# warn "child: event = ".sprintf("%*vX\n", ":", $event);
	        	print $OFH $event;
	    	}
			close $OFH;
	    	exit(0);
		}
	} # endloop

	# we only get here after all children have been started
	$SIG{'INT'} = sub { exit 0; };  # so that after ^C the END block runs
	eval $end_eval_code;
	if ($@) { warn "can't eval $end_eval_code: $@\n"; }
	my $device; my $a = $InputPort;
	if ($a =~ /^$|^\d+(:\d)?$/)  {
		($device, $end_eval_code) = alsaport2device($a, 'in');
		eval $end_eval_code;
		if ($@) { warn "can't eval $end_eval_code: $@\n"; }
	} elsif ($a =~ /^midiC/)  { $device = "/dev/snd/$a";
	} elsif ($a =~ /^midi\d/) { $device = "/dev/$a";
	} elsif ($a eq '-')       { $IFH = *STDIN;
	} else { die "bad -i arg: $a\n";
	}
	if (!$IFH and !open $IFH, "<$device") { die "can't open $device: $!\n"; }

	foreach my $channel (keys %pitch_change) {
		my $byte1 = 0xE0 | $channel;
		my $change = int(8192.5 + $pitch_change{$channel});
		my $msb = $change >> 7;
		my $lsb = $change & 0x7F;
		# warn "change=$change byte1=$byte1 msb=$msb lsb=$lsb\n\n\n";
		print $OFH chr($byte1).chr($lsb).chr($msb);
	}

	my $status_byte; 
	while (1) {
		my @command;  my $char1;
		if (! read $IFH,$char1,1) { last; }
		my $byte1 = ord $char1;
        # my $byte1 = ord getc($IFH);
        if (! defined $byte1) { last; }
		# because of possible running status, first put together the command
		if ($byte1 < 0x80) {  # hmm... must be running status
			next unless $status_byte;
			if ($status_byte <= 0xBF) {
				@command = (chr($status_byte), $char1, getc($IFH));
			} elsif ($status_byte <= 0xDF) { # 2.4
				@command = (chr($status_byte), $char1);
			} elsif ($status_byte <= 0xEF) { # 2.4
				@command = (chr($status_byte), $char1, getc($IFH));
			} elsif ($status_byte == 0xF0) {  # start of sysex
				@command = (chr($status_byte), $char1);
				my $next_char = getc($IFH);
	       		if (! defined $next_char) { last; }
				push @command, $next_char;
				if (0xF7 == ord $next_char) { last; }
			}
		} else {
			$status_byte = $byte1;
			if ($status_byte <= 0xBF) {
				@command = ($char1,getc($IFH),getc($IFH));
			} elsif ($status_byte <= 0xDF) { # 2.4
				@command = ($char1, getc($IFH));
			} elsif ($status_byte <= 0xEF) { # 2.4
				@command = ($char1,getc($IFH),getc($IFH));
			} elsif ($status_byte == 0xF0) {  # start of sysex
				@command = ($char1,);
				my $next_char = getc($IFH);
	       		if (! defined $next_char) { last; }
				push @command, $next_char;
				if (0xF7 == ord $next_char) { last; }
			}
		}
		# printf STDERR "command = %vx\n", join(q{},@command);
			
       	print $OFH @command;  # original signal goes straight-through
		if ($status_byte==0xF0 or 0xC0==($status_byte & 0xF0)) {
			next;  # patch-change, or start of sysex - dont add echoes
		} elsif (0xB0 == ($status_byte&0xF0) and !$DoEchoCC{$command[$[+1]}) {
			#printf STDERR "didn't echo CC = %vx\n", join(q{},@command);
			next;  
		} elsif (0xE0 == ($status_byte&0xF0)) {  # 2.4 don't echo pitch-bend
			# printf STDERR "didn't echo CC = %vx\n", join(q{},@command);
			next;  
		} else {  # noteon, noteoff, controller, pressure
			my $cha = $status_byte & 0x0F;
			my $now = usecs();
			my $note = ord $command[$[+1];
			next unless $Channel{$cha} && (!%EchoNotes||$EchoNotes{"$note"});
			foreach my $j ($[ .. $#Delays) {
				my $delay = $Delays[$j];
        		my $usecs = 1000*$delay + $now;
				if (defined $Echoes[$j]) {
					$command[$[] = chr (($status_byte & 0xF0) | $Echoes[$j]);
				}
				if (0x90 == ($status_byte & 0xF0)) {  # note-on
					my $quietenedvol = ord $command[$[+2];
					if ($quietenedvol > 0) {
						$quietenedvol -= $Quietenings[$j];
						if ($quietenedvol < 1) { $quietenedvol = 1; }
						$command[$[+2] = chr $quietenedvol;
					} else {
						$command[$[] = chr (ord($command[$[]) & 0x8F);
					}
				}
				$pipe = $PIPES[$j];
        		printf $pipe '%016d%6d%s', $usecs, scalar @command,
				 join(q{},@command);
			}
		}
    }
	foreach my $j ($[ .. $#Delays) {
		# warn "parent about to close PIPES[$j]\n";
		my $pipe = $PIPES[$j];  close $pipe;
		my $b = chr(0xB0 + $Echoes[$j]); print $OFH "$b\x78\x00";
	}
	close $OFH;
	exit 0;
}

# we're in MIDI-file mode (not RealTime-mode) ...
eval 'require MIDI'; if ($@) {
	die "you'll need to install the MIDI::Perl module from www.cpan.org\n";
}
import MIDI;
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


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;
	}
}

# ----------- RealTime stuff, IDENTICAL to midikbd --------------
sub device_file {
	my %connected_to = connected_to();
	if (! opendir(D, '/dev/snd')) {
		# should look for /dev/midi[0-9]+ tclmidi files ...
		# and are there OSS-specific files also ?
		die "can't opendir /dev/snd: $!\n";
	}
	my @midi_files = sort grep /^midiC/, readdir D;
	closedir D;
	foreach (@midi_files) {
		if ($connected_to{$_}) {
			$_ .= " (connected to $connected_to{$_})";
		}
	}
	if (!@midi_files) {
		die "no raw-midi (midiC*) device-files found in /dev/snd\n";
	} elsif (1 == @midi_files) {
		return "/dev/snd/$midi_files[$[]";
	} else {
		eval 'require Term::Clui'; if ($@) { die
			"you'll need to install the Term::Clui module from www.cpan.org\n";
		}
		my $f=Term::Clui::choose("to which raw-midi device-file ?\n\n"
		 .'  ( $ALSA_OUTPUT_PORTS was not set... )', @midi_files);
		if (! $f)  { exit; }
		$f =~ s/ \(.*$//;
		return "/dev/snd/$f";
	}
}
sub connected_to {
	if (! open(P, 'aconnect -oil |')) {
		warn "warning: connected_to can't run  aconnect -oil: $!\n";
		return ();
	}
	my %inport2device;  my %device2inport;  my %connected_to;
	my $major; my $minor; my $inport; my $outport;
	while (<P>) {
		if (/^client\s*(\d+:)/) {  $major = $1;
		} elsif ($major>0 and /^\s+(\d)\s+'(.*)'/) {
			$minor = $1; my $device = $2; $device =~ s/\s+$//;
			$inport2device{"$major$minor"} = $device;
			$device2inport{$device} = "$major$minor";
		} elsif ($major>0 and /^\s+Connecting To:\s+(\d+:\d)/i) {
			my $dest_mm = $1;
			my $src_dev = $inport2device{"$major$minor"};
			if ($src_dev =~ /VirMIDI (\d)-(\d)/i) {
				$connected_to{"midiC${1}D${2}"} = $dest_mm;
			}
		}
	}
	close P;
	while (my ($k, $v) = each %connected_to) {
		if ($inport2device{$v}) { $connected_to{$k} = $inport2device{$v};
		} else { delete $connected_to{$k};
		}
	}
	return %connected_to;
}
sub alsaport2device { my ($alsaport, $direction) = @_;
	# MUST BE KEPT IN SYNC WITH alsaport2device IN midiecho !
	if (!$alsaport) {
		if ($direction eq 'in') { $alsaport = $ENV{'ALSA_INPUT_PORTS'};
		} else { $alsaport = $ENV{'ALSA_OUTPUT_PORTS'};
		}
		if (!$alsaport) { return ''; }
	}
	# seek unconnected virmidi ports, choose one, aconnect it to $alsaport,
	# set up an END subroutine to disconnect it on exit, and
	# return the virmidi port's corresponding /dev/snd/midiCnDn device.
	if ($alsaport =~ /^\d+$/) { $alsaport .= ':0'; }
	if (! open(P, 'aconnect -oil |')) {
		warn "warning: alsaport2device can't run  aconnect -oil: $!\n";
		return '';
	}
	my %virport2device;  my %device2virport;
	my $major; my $minor; my $device;
	while (<P>) {
		if (/^client\s*(\d+):/) {  $major = $1;
		} elsif ($major>0 and /^\s+(\d)\s+'VirMIDI (\d)-(\d)/i) {
			$minor = $1; $device = "midiC${2}D${3}";
			$virport2device{"$major:$minor"} = $device;
			$device2virport{$device} = "$major:$minor";
		} elsif ($major>0 and /^\s+Connecting To:\s+/i) {
			delete $device2virport{$device};
			delete $virport2device{"$major:$minor"};
		}
	}
	close P;
	if (! %virport2device) {
		warn "warning: no free virtual-midi ports found\n"; return '';
	}
	my @virports = sort keys %virport2device;
	my $virport = $virports[$[];
	my $end_eval_code;
	if ($direction eq 'in') {
		my $retval = system ("aconnect",$alsaport,$virport);
		if ($retval!=0) { die "couldn't run aconnect $alsaport $virport\n"; }
		# Have to connect it to itself to make it readable. Don't ask...
		$retval = system ("aconnect",$virport,$virport);
		if ($retval!=0) { die "couldn't run aconnect $virport $virport\n"; }
		$end_eval_code
		 = "sub END { system ('aconnect','-d','$alsaport','$virport'); "
		 . "system ('aconnect','-d','$virport','$virport'); }";
		if ($@) { warn "can't eval: $@\n"; }
	} else {
		my $retval = system ("aconnect",$virport,$alsaport);
		if ($retval!=0) { die "couldn't run aconnect $virport $alsaport\n"; }
		$end_eval_code
		 = "sub END { system ('aconnect','-d','$virport','$alsaport'); }";
		if ($@) { warn "can't eval: $@\n"; }
	}
	return ('/dev/snd/'.$virport2device{$virport}, $end_eval_code);
}
# ----------- RealTime stuff, IDENTICAL to delay --------------
# see perldoc perlfork,  3/4 way through, "Forking pipe open"
# The following example shows how to write to a forked child:
sub pipe_to_fork ($) {
	my $parent = shift;
	pipe my $child, $parent or die;
	my $pid = fork();
	die "fork() failed: $!" unless defined $pid;
	if ($pid) {
		close $child;
	} else {
		close $parent;
		open(STDIN, "<&=", fileno($child)) or die;  # see perldoc -f open
	}
	$pid;
}
sub usecs {
	my ($secs, $usecs) = Time::HiRes::gettimeofday();
	return 1000000*($secs-$Zero_secs) + $usecs;
}
# ---------------- other RealTime stuff  -------------------
sub binary_insert { my ($item, @list) = @_;
	die "binary_insert didn't actually get used.\n";
	if (! @list) { return ($item,); }
	my $i_toobig = $#list;
	my $i_toosmall = $[;
	while (1) {
		$i = int 0.5 * ($i_toobig+$i_toosmall);
		if (($i_toobig-$i_toosmall) < 2) {
			splice @list,$i_toobig,0,$item; last;
		}
		if ($item ge $list[$i_toobig]) {
			splice @list,$i_toobig+1,0,$item; last;
		}
		if ($item le $list[$i_toosmall]) {
			splice @list,$i_toosmall,0,$item; last;
		}
		if ($list[$i] eq $item) { splice @list,$i,0,$item; last; }
		if ($list[$i] lt $item) { $i_toosmall = $i; next; }
		$i_toobig = $i; next;
	}
	return @list;
}

__END__

=pod

=head1 NAME

midiecho - Simulates tape-delay echo: on MIDI files, or on real-time MIDI

=head1 SYNOPSIS

 # on midi-files ( *.mid ) :
 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

 # on real-time (raw) midi :
 midiecho -i 22:0 -o 128:0 -c 3 -d 450,900  # from ALSAport 22 to 128
 midikbd -o - 1:90 0:105 | midiecho -i - -d 1 -q 40 -e 1

=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.

Since version 2.0, the -i and -o options
allow I<midiecho> to work on real-time (raw) midi inputs,
as well as on midi files.

=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<-i 20:0> or I<-i midiC2D1>

This option puts I<midiecho> into raw-midi (or real-time, or midi-on-the-wire)
mode, and takes the midi-data from the specified port.

In the first example, the port is specified as an ALSA-port;
you can check out the available ports with the command
I<arecordmidi -l> or I<aconnect -il>.
In the second example, the port is one of the raw-midi device files in
I</dev/snd/>
(just be warned that if you want to input from a virtual-midi
device, you have to connect the client to itself e.g.:
I<aconnect 24 24>,
don't ask me why)

If there are no free Virtual-MIDI ports, then you need to reload the
I<snd-virmidi> kernel-module with more virtual sound-cards enabled, e.g.:
  modprobe -r snd-virmidi
  modprobe snd-virmidi enable=1,1

=item I<-o 128:0> or I<-o midiC2D3>

This option assumes I<midiecho> is in raw-midi mode
(i.e. you also need the I<-i> option),
and sets the ouput-port to which the midi output will be sent.
The default ouput-port is the environment variable $ALSA_OUTPUT_PORTS

As with the I<-i> option,
in the first example, the port is specified as an ALSA-port;
you can check out the available ports with the command
I<aplaymidi -l> or I<aconnect -ol>.
In the second example, the port is one of the raw-midi device files in
I</dev/snd/>
(just be warned that only one process can open a raw-midi device file at once).

If the device is   -   then it reads from STDIN, e.g.:
  midikbd -d - | midiecho -i - -d 250,450 -q 45 -e 1,2

=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