#! /usr/bin/perl
#########################################################################
#        This Perl script is Copyright (c) 2010, 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.             #
#########################################################################
use Term::ReadKey;
use bytes;
#use Term::Size(); my ($Xmax, $Ymax) = Term::Size::chars;
my ($Xmax, $Ymax) = Term::ReadKey::GetTerminalSize;
# warn "Xmax=$Xmax Ymax=$Ymax\n";
my $CurrentX; my $CurrentY;
my $Version       = '4.1';  # CursorRow set correctly for drumkit keymap
my $VersionDate   = '19aug2010';
my $DeviceFile   = '';
my $OFH;
my $Channel   = 0;
my $Volume    = 100;
my $Pan       = 64;
my $Transpose = 0;
my $Quiet     = 0;
my $PedalIsOn = 0;
my $KeyMap    = 'piano';
my %KeyMaps   = (   # 4.0
	a=>'augmented', d=>'drumkit', h=>'harmonic', p=>'piano', w=>'wholetone',
);
my %Cha2patch;
my %Cha2pan;
my %AutoPan;
my $LastB;
my $AlsaPort;
my @Synopsis; my %Keystrokes;
my $CursorRow = 7;
# vt100 globals
my $Irow = 1;
my $Icol = 1;
# mouse-related stuff, version 3.6
my %Cha2Xcontroller = ();
my %Cha2Ycontroller = ();


# http://invisible-island.net/xterm/ctlseqs/ctlseqs.html
# use bytes;
# print STDERR "\e[?1003h";   # sets  SET_ANY_EVENT_MOUSE  mode
# ^[[M#XY    where X is (chr(32+x)) and Y is (chr(32+y)), top-left is !!=1,1
# and LeftButtonPress = ^[[M XY  Mid = ^[[M!XY   Right = ^[[M"XY
# print STDERR "\e[?1003l";   # resets  SET_ANY_EVENT_MOUSE  mode

while ($ARGV[$[] =~ /^-([CPa-z])([adhpw]?)/) {
	my $opt = $1;
	if ($opt eq 'v')      { shift;
		my $n = $0; $n =~ s{^.*/([^/]+)$}{$1};
		print "$n version $Version $VersionDate\n";
		exit 0;
	} elsif ($opt eq 'd' or $opt eq 'o') { shift; my $f = shift;
		if ($f =~ /^\d+(:\d+)?$/)  { $AlsaPort = $f;
		} elsif ($f =~ /^midiC/)  { $DeviceFile = "/dev/snd/$f";
		} elsif ($f =~ /^midi\d/) { $DeviceFile = "/dev/$f";
		} else { $DeviceFile = $f;
		}
	} elsif ($opt eq 'p') { shift; $AlsaPort = shift;
	} elsif ($opt eq 'C') { shift;
		warn "warning: -C option is now deprecated; see perldoc midikbd\n";
		while (my $next_arg = shift) { process_channel_spec($next_arg); }
	} elsif ($opt eq 'P') { shift; $Cha2patch{$Channel} = 0+shift;
	} elsif ($opt eq 'k') {
		shift;
		if ($KeyMaps{$2}) { $KeyMap = $KeyMaps{$2};
		} else { $KeyMap  = shift;
		}
	} elsif ($opt eq 'q') { shift; $Quiet   = 1;
	} else {  print "usage:\n";  my $synopsis = 0;
		while (<DATA>) {
			if (/^=head1 SYNOPSIS/) { push @Synopsis,$_; $synopsis=1; next; }
			if ($synopsis && /^=head1/) { last; }
			if ($synopsis)      { print $_; next; }
		}
		exit 1;
	}
}
foreach my $channel_spec (@ARGV) { process_channel_spec($channel_spec); }

#warn "Channel=$Channel\n";
#foreach (sort keys %Cha2Xcontroller) {
#	warn "Cha2Xcontroller{$_} = $Cha2Xcontroller{$_}\n";
#}
#foreach (sort keys %Cha2Ycontroller) {
#	warn "Cha2Ycontroller{$_} = $Cha2Ycontroller{$_}\n";
#}
#exit;

my $in_syn; my $in_keys;
while (<DATA>) {
	if (/^ +Q = Quit/)     {
		if ($KeyMap eq 'drumkit') { push @Synopsis, " Q = Quit\n";
		} else { push @Synopsis, $_;
		}
		$in_syn = 1; next;
	}
	if ($in_syn && /^$/) { last; }
	if ($in_syn) {
		if (/octave|semitone/ && ($KeyMap eq 'drumkit')) { next; }
		push @Synopsis, $_;
	}
}
while (<DATA>) {
	if (/^ the "$KeyMap" keymap/)     {
		$in_keys = 1; push @{$Keystrokes{$KeyMap}}, $_; next;
	}
	if ($in_keys && /^$/) { last; }
	if ($in_keys) { push @{$Keystrokes{$KeyMap}}, $_; }
}
my %Char2note = char2note($KeyMap);

if ($AlsaPort or ! $DeviceFile) { $DeviceFile = alsaport2device($AlsaPort); }
if (! $DeviceFile) { $DeviceFile = device_file(); }

$SIG{'INT'} = sub { exit 0; };  # so that after ^C the END-blocks run
if ($DeviceFile eq '-') { $OFH = *STDOUT;
} elsif (! open $OFH, ">$DeviceFile") { die "can't open $DeviceFile: $!\n";
}
select $OFH; $| = 1;

ReadMode(4, STDIN);
# should do this for all keys of %Cha2patch, e.g. for feeding into midiecho
# if (defined $Cha2patch{$Channel}) { new_patch($Cha2patch{$Channel}); }
foreach my $c (keys %Cha2patch) { set_patch($c, $Cha2patch{$c}); }
foreach my $c (keys %Cha2pan)   {  set_pan( $c,  $Cha2pan{$c}); }
my $NoteOn  = chr(0x90 + $Channel);
my $NoteOff = chr(0x80 + $Channel);
my $VolByte = chr($Volume);
if ($KeyMap ne 'drumkit') {
	display_channel(); display_patch(); display_transpose();
}
display_note(); display_volume(); display_pan();
if (!$Quiet) { display_keystrokes(); }

if (%Cha2Xcontroller or %Cha2Ycontroller) {   # 3.6
	print STDERR "\e[?1003h";   # sets  SET_ANY_EVENT_MOUSE  mode
	eval 'sub END { print STDERR "\e[?1003l"; }';  # reset on exit
	if ($@) { warn "can't eval: $@\n"; }
}

while (1) {
	my $c = ReadKey(0, STDIN);
	# reserve S=SustainPed B=Bank G=GeneralMidi M=Monophonic K=KeyMap
	if      ($c eq "Q")  { note_off();  last;
	} elsif ($c eq "P")  { new_patch();  next;
	} elsif ($c eq "C")  { note_off(); new_channel(); next;
	} elsif ($c eq "U")  {  # 3.2
		if ($KeyMap ne 'drumkit') { $Transpose += 1; display_transpose(); }
		next;
	} elsif ($c eq "D")  {  # 3.2
		if ($KeyMap ne 'drumkit') { $Transpose -= 1; display_transpose(); }
		next;
	} elsif ($c eq "\e") { escape_seq();  next;
	}
	my $note = $Char2note{$c};
	my $transposed = $note + $Transpose ;
	if ($transposed > 127 ) { $transposed = 127;
	} elsif ($transposed < 0) { $transposed = 0;
	}
	my $b = chr($transposed);
	note_off();
	if (defined $note) { print $OFH "$NoteOn$b$VolByte"; $LastB = $b; }
	display_note($note, $transposed);
	# else { warn "c is ".ord($c)."\n"; }
}
if (!$Quiet) { clean_screen(); }
if ($PedalIsOn) { my $b = chr(0xB0 + $Channel); print $OFH "$b\x40\x00"; }
close $OFH;
ReadMode(0, STDIN);

# ------------------- infrastructure -------------------
sub display_channel {
	gotoxy(1,1); puts("Channel is $Channel"); gotoxy(1,$CursorRow);
}
sub display_patch {
	gotoxy(1,2);
	if (defined $Cha2patch{$Channel}) { puts("Patch is $Cha2patch{$Channel}");
	} else { puts("Patch hasn't been reset yet");
	}
	gotoxy(1,$CursorRow);
}
sub display_transpose {
	if ($Transpose < -48) { $Transpose = -48;
	} elsif ($Transpose >48) { $Transpose = 48;
	}
	gotoxy(1,3);
	if ($Transpose > 0) { puts("Transpose is +$Transpose");
	} else {              puts("Transpose is $Transpose");
	}
	gotoxy(1,$CursorRow);
}
sub display_note { my ($note, $transposed) = @_;
	gotoxy(1,$CursorRow-3);
	if (! defined $note) { puts("Note is off");
	} elsif ($transposed == $note) { puts("Note is $note");
	} else { puts("Note is $note transposed to $transposed");
	}
	gotoxy(1,$CursorRow);
}
sub display_volume {
	gotoxy(1,$CursorRow-2);  puts("Volume is $Volume");
	$VolByte = chr($Volume);
	gotoxy(1,$CursorRow);
}
sub display_pan {
	gotoxy(1,$CursorRow-1);
	if ($AutoPan{$Channel}) { puts("$AutoPan{$Channel} AutoPan");
	} elsif (defined $Cha2pan{$Channel}) { puts("Pan is $Cha2pan{$Channel}");
	} else { puts("Pan hasn't been reset yet");
	}
	gotoxy(1,$CursorRow);
}
sub display_keystrokes {
	my @s = (@{$Keystrokes{$KeyMap}},"\n",@Synopsis);
	gotoxy(1,$CursorRow+1); puts(@s); gotoxy(1,$CursorRow);
}
sub clean_screen {
	my @s = (@{$Keystrokes{$KeyMap}},"\n",@Synopsis);
	for my $y ($CursorRow+1 .. ($CursorRow+1+@s)) { gotoxy(1,$y); puts(''); }
	gotoxy(1,$CursorRow);
}


sub set_pan { my ($c,$p) = @_;
	if ($p >112)  { $p = 112; } else { $p -= 16; }
	if ($p < 1)   { $p = 1; }
	my $b = chr(0xB0 + $c);  $p = chr($p);
	print $OFH "$b\x0A$p";
}
sub set_patch { my ($c,$p) = @_;
	if (! defined $p) { return; }
	my $b1 = chr(0xC0 + $c);
	my $b2 = chr(0+$p);
	print $OFH "$b1$b2";
}
sub new_patch { 
	if ($KeyMap eq 'drumkit') { return; }
	my $p;
	if (defined $_[$[]) { $p = $_[$[]; } else { $p = get_int('Patch'); }
	if (! defined $p) { return; }   # BUG should display
	my $b1 = chr(0xC0 + $Channel);
	my $b2 = chr($p);
	print $OFH "$b1$b2";
	$Cha2patch{$Channel} = $p;
	display_patch();
}
sub new_channel {
	if ($KeyMap eq 'drumkit') { return; }
	my $c = get_int('Channel');
	if (! defined $c) { return; }   # BUG should display
	note_off();
	$Channel = $c;
	$NoteOn  = chr(0x90 + $Channel);
	$NoteOff = chr(0x80 + $Channel);
	display_channel(); display_patch(); display_pan();
}

sub escape_seq {
	my $c = ReadKey(0, STDIN);
	if ($c eq 'O') {  # a FunctionKey F1..F4
		$c = ReadKey(0, STDIN);  # P,Q,R,S
		my $b = chr(0xB0 + $Channel);
		if ($c eq 'P' or $c eq 'Q') {  # take or renew pedal 3.5
			if ($PedalIsOn) { print $OFH "$b\x40\x00"; }
			print $OFH "$b\x40\x7F"; $PedalIsOn = 1;
		} else {   # pedal off
			if ($PedalIsOn) { print $OFH "$b\x40\x00"; $PedalIsOn = 0; }
		}
		return;
	}
	if ($c ne '[') { return; }
	$c = ReadKey(0, STDIN);
	
	if      ($c eq '5') {  # PageUp,
		if ($KeyMap ne 'drumkit') {
			$Transpose += 12; display_transpose(); return;
		}
	} elsif ($c eq '6') {  # PageDown
		if ($KeyMap ne 'drumkit') {
			$Transpose -= 12; display_transpose(); return;
		}
	} elsif ($c eq 'A') {  # 3.2 ArrowUp, ArrowDown are now volume
		if ($Volume < 10)  { $Volume = 10; } else { $Volume += 10; }
		if ($Volume > 127) { $Volume = 127; }
		display_volume();
	} elsif ($c eq 'B') {
		if ($Volume >120)  { $Volume = 120; } else { $Volume -= 10; }
		if ($Volume < 1)   { $Volume = 1; }
		display_volume();
	} elsif ($c eq 'C') { # 3.2 ArrowRight is now Pan
		my $Pan = $Cha2pan{$Channel} || 64;
		if ($Pan < 16)  { $Pan = 16; } else { $Pan += 16; }
		if ($Pan > 127) { $Pan = 127; }
		$Cha2pan{$Channel} = $Pan;
		my $b = chr(0xB0 + $Channel);  my $p = chr($Pan);
		print $OFH "$b\x0A$p";
		display_pan();
	} elsif ($c eq 'D') {  # 3.2 ArrowLeft is now Pan
		my $Pan = $Cha2pan{$Channel} || 64;
		if ($Pan >112)  { $Pan = 112; } else { $Pan -= 16; }
		if ($Pan < 1)   { $Pan = 1; }
		$Cha2pan{$Channel} = $Pan;
		my $b = chr(0xB0 + $Channel);  my $p = chr($Pan);
		print $OFH "$b\x0A$p";
		display_pan();
	} elsif ($c eq 'F') { all_sounds_off();
	} elsif ($c eq 'H') { reset_all_controllers();
	} elsif ($c eq 'M') {   # 3.6
		# ^[[M#XY  where X is (chr(32+x)), Y is (chr(32+y)), top-left is !!=1,1
		# and LeftButtonPress = ^[[M XY  Mid = ^[[M!XY   Right = ^[[M"XY
		my $c = ReadKey(0, STDIN);
		my $x = ReadKey(0, STDIN);
		my $y = ReadKey(0, STDIN);
		next unless $c eq '#';
		$x = round ((ord($x)-32) * 127.8 / $Xmax);
        if ($x >127) { $x = 127; }
        $y = 126 - round ((ord($y)-33) * 127.8 / $Ymax);
        if ($y >127) { $y = 127; }
#warn "x=$x y=$y\n";
        if ($x != $CurrentX) { x_controllers($x); $CurrentX = $x; }
        if ($y != $CurrentY) { y_controllers($y); $CurrentY = $y; }
	} elsif ($c eq '1') {  # a FunctionKey F5..F8
		my $c = ReadKey(0, STDIN);
		if ($c eq '5') {  # F5: slow autopan
			$AutoPan{$Channel} = 'Slow';
		} elsif ($c eq '7') {  # F6: medium autopan
			$AutoPan{$Channel} = 'Medium';
		} elsif ($c eq '8') {  # F7: fast autopan
			$AutoPan{$Channel} = 'Fast';
		} elsif ($c eq '9') {  # F8: autopan off
			$AutoPan{$Channel} = '';
		} else { gotoxy(1,$CursorRow); return;
		}
		my $should_be_tilde = ReadKey(0, STDIN);
		display_pan();
	} else { gotoxy(1,$CursorRow); return;
	}
}
sub get_int { my $s = $_[$[];
	my $max_int = 127;
	my $row = 2;
	if ($s =~ /channel/i) { $max_int = 15; $row = 1; }
	ReadMode(0, STDIN);
	my $int;
	while (1) {
		gotoxy(1,$row); puts("new $s (0..$max_int) ? ");
		$int = <STDIN>; print STDERR "\e[A";
		if ($int =~ /^[0-9]+$/ and $int <= $max_int) {
			ReadMode(4, STDIN); gotoxy(1,$row); return 0+$int;
		}
		if ($int =~ /^\s*$/) {
			ReadMode(4, STDIN); gotoxy(1,$row); return undef;
		}
	}
}
sub note_off {  # 1.9
	if (defined $LastB) { print $OFH "$NoteOff$LastB$VolByte"; undef $LastB; }
}
sub all_sounds_off {
	foreach my $c (0..15) { my $b = chr(0xB0 + $c); print $OFH "$b\x78\x00"; }
}
sub reset_all_controllers {
	foreach my $c (0..15) { my $b = chr(0xB0 + $c); print $OFH "$b\x79\x00"; }
}
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) { return ''; }
	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[$[];
	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"; }
		eval "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"; }
		eval "sub END { system ('aconnect','-d','$virport','$alsaport'); }";
		if ($@) { warn "can't eval: $@\n"; }
	}
	return '/dev/snd/'.$virport2device{$virport};
}
sub char2note {  my $keymap = $_[$[];
	if ($keymap eq 'piano' or !defined $keymap) { return (
		a=>47,z=>48,s=>49,x=>50,d=>51,c=>52,v=>53,g=>54,b=>55,
		h=>56,n=>57,j=>58,m=>59,','=>60,l=>61,'.'=>62,';'=>63,"/"=>64,
		"'"=>65,'`'=>64,
		"\t"=>65,'1'=>66,q=>67,'2'=>68,w=>69,'3'=>70,e=>71,
		r=>72,'5'=>73,t=>74,'6'=>75,y=>76,u=>77,'8'=>78,i=>79,
		'9'=>80,o=>81,'0'=>82,p=>83,'['=>84,'='=>85,']'=>86,
		"\cH"=>87,"\x7F"=>87,'\\'=>88,);
	} elsif ($keymap eq 'wholetone') { return (
 '`'=>55,'1'=>57,'2'=>,59,'3'=>,61,'4'=>,63,'5'=>65,'6'=>67,'7'=>69,
    '8'=>71,'9'=>73,'0'=>75,"-"=>77,'='=>79,"\cH"=>81,"\x7F"=>81,
  "\t"=>56,q=>58,w=>60,e=>62,r=>64,t=>66,y=>68,u=>70,
	 i=>72,o=>74,p=>76,"["=>78,']'=>80,'\\'=>82,
   a=>35,s=>37,d=>39,f=>41,g=>43,h=>45,j=>47,k=>49,l=>51,';'=>53,"'"=>55,
    z=>36,x=>38,c=>40,v=>42,b=>44,n=>46,m=>48,','=>50,'.'=>52,'/'=>54,);
	} elsif ($keymap eq 'augmented') { return (
 '`'=>34,'1'=>36,'2'=>,40,'3'=>,44,'4'=>,48,'5'=>52,'6'=>56,'7'=>60,
    '8'=>64,'9'=>68,'0'=>72,"-"=>76,'='=>79,"\cH"=>81,"\x7F"=>81,
  "\t"=>35,q=>37,w=>41,e=>45,r=>49,t=>53,y=>57,u=>61,
	 i=>65,o=>69,p=>73,"["=>77,']'=>80,'\\'=>82,
   a=>38,s=>42,d=>46,f=>50,g=>54,h=>58,j=>62,k=>66,l=>70,';'=>74,"'"=>78,
    z=>39,x=>43,c=>47,v=>51,b=>55,n=>59,m=>63,','=>67,'.'=>71,'/'=>75,);
	} elsif ($keymap eq 'harmonic') { return (
 '1'=>63,'2'=>67,'3'=>,70,'4'=>,74,'5'=>77,'6'=>81,'7'=>84,
    '8'=>88,'9'=>91,'0'=>95,'-'=>98,"="=>102,"\cH"=>105,"\x7F"=>105,
  q=>58,w=>62,e=>65,r=>69,t=>72,y=>76,u=>79,i=>83,o=>86,p=>90,"["=>93,']'=>97,
   a=>53,s=>57,d=>60,f=>64,g=>67,h=>71,j=>74,k=>78,l=>81,';'=>85,"'"=>88,
    z=>48,x=>52,c=>55,v=>59,b=>62,n=>66,m=>69,','=>73,'.'=>76,'/'=>80,);
	} elsif ($keymap eq 'drumkit') { $Channel = 9; $CursorRow = 4; return (
# 35 bassdrum, 40 snare, 44 hihat, 49 57 splash, 51 59 ride, 43 45 47 48 toms
'1'=>39,'2'=>56,'3'=>,67,'4'=>,68,'5'=>74,'6'=>75,'7'=>77,
    '8'=>60,'9'=>61,'0'=>62,'-'=>63,"="=>64,"\cH"=>81,"\x7F"=>81,
q=>42,w=>42,e=>44,r=>44,t=>46,y=>46,u=>51,i=>59,o=>49,p=>57,'['=>55,']'=>53,
 a=>37,s=>37,d=>40,f=>40,g=>38,h=>38,j=>41,k=>43,l=>45,';'=>47,';'=>48,"'"=>50,
	z=>35,x=>35,c=>35,v=>35,b=>35,n=>35,m=>36,','=>36,'.'=>36,'//'=>36,
		);
	} else {
		die "unrecognised KeyMap: $keymap\n"
		 . " must be: piano, wholetone, harmonic or drumkit.\n";
	}
}

# ---------------------- infrastructure for 3.6 ---------------------
sub process_channel_spec { my $arg = $_[$[];
	# warn "process_channel_spec arg=$arg\n";
	if ($arg !~ /^[-xy:,\d]+$/) { unshift @ARGV, $arg; last; }
	my ($cha,@a) = split(':', $arg);
	if (!length $cha) { next; }
	$Channel = 0+$cha;
	if ($Channel<0 or $Channel>15) {
		die "channel must be between 0 and 15, but was $Channel\n";
	}
	my $i = 1; foreach my $a (@a) {
		if ($a =~ /^x(-?\d+)/) {   # 3.6
			my $con = $1;   # controller-number
			if($con<-127 or $con>127){
                  	die "-x channel $Channel controller must be "
				 . "between 0 and 127, but was $con\n";
			}
			if     ($con eq '-0') { $Cha2Xcontroller{$Channel} = -1000;
			} elsif ($con eq '0') { $Cha2Xcontroller{$Channel} = 1000;
			} else { $Cha2Xcontroller{$Channel} = 0+$con;
			}
		} elsif ($a =~ /^y(-?\d+)/) {   # 3.6
			my $con = $1;   # controller-number
			if($con<-127 or $con>127){
                  	die "-y channel $Channel controller must be "
				 . "between 0 and 127, but was $con\n";
			}
			if     ($con eq '-0') { $Cha2Ycontroller{$Channel} = -1000;
			} elsif ($con eq '0') { $Cha2Ycontroller{$Channel} = 1000;
			} else { $Cha2Ycontroller{$Channel} = 0+$con;
			}
		} elsif ($i == 1 and length $a) { $Cha2patch{$Channel} = 0+$a;
		} elsif ($i == 2 and length $a) { $Cha2pan{$Channel} = 0+$a;
		}
		$i += 1;
	}
}
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 x_controllers { my $x = $_[$[];
	if ($x > 127) { $x = 127; } elsif ($x < 0) { $x = 0; }
	while (my ($cha, $con) = each %Cha2Xcontroller) {
		my $xc;
		if ($con < 0) { $con = 0-$con; $xc = chr(127-$x);
		} else { $xc = chr($x);
		}
		# warn "x_controllers cha=$cha xc=$xc\n";
		if ($con == 1000) {  # special-cased for Pitch-Bend
			my $b = chr(0xE0 + $cha); print $OFH "$b$xc$xc";
		} else {
			my $b = chr(0xB0 + $cha); my $c = chr($con); print $OFH "$b$c$xc";
		}
	}
}
sub y_controllers { my $y = $_[$[];
	if ($y > 127) { $y = 127; } elsif ($y < 0) { $y = 0; }
	while (my ($cha, $con) = each %Cha2Ycontroller) {
		my $yc;
		if ($con < 0) { $con = 0-$con; $yc = chr(127-$y);
		} else { $yc = chr($y);
		}
		if ($con == 1000) {  # special-cased for Pitch-Bend
			my $b = chr(0xE0 + $cha); print $OFH "$b$yc$yc";
		} else {
			my $b = chr(0xB0 + $cha); my $c = chr($con); print $OFH "$b$c$yc";
		}
	}
}

# --------------- vt100 stuff, copied from Term::Clui ---------------
sub puts   { my $s = join q{}, @_;
	$Irow += ($s =~ tr/\n/\n/);
	if ($s =~ /\r\n?$/) { $Icol = 0;
	} else { $Icol += length($s);
	}
	print STDERR "$s\e[K";   # and clear-to-eol
}
sub up    {
	# if ($_[$[] < 0) { down(0 - $_[$[]); return; }
	print STDERR "\e[A" x $_[$[]; $Irow -= $_[$[];
}
sub down  {
	# if ($_[$[] < 0) { up(0 - $_[$[]); return; }
	print STDERR "\n" x $_[$[]; $Irow += $_[$[];
}
sub right {
	# if ($_[$[] < 0) { left(0 - $_[$[]); return; }
	print STDERR "\e[C" x $_[$[]; $Icol += $_[$[];
}
sub left  {
	# if ($_[$[] < 0) { right(0 - $_[$[]); return; }
	print STDERR "\e[D" x $_[$[]; $Icol -= $_[$[];
}
sub gotoxy { my $newcol = shift; my $newrow = shift;
	if ($newcol == 0) { print STDERR "\r" ; $Icol = 0;
	} elsif ($newcol > $Icol) { right($newcol-$Icol);
	} elsif ($newcol < $Icol) { left($Icol-$newcol);
	}
	if ($newrow > $Irow)      { down($newrow-$Irow);
	} elsif ($newrow < $Irow) { up($Irow-$newrow);
	}
}


__END__

=pod

=head1 NAME

midikbd - a simple monophonic ascii-midi-keyboard

=head1 SYNOPSIS

 midikbd [-o output] [-ka|-kd|-kh|-kp|-kw] [-q] <ChannelSpec>...
 midikbd -o 128:0     # plays to ALSA-port 128:0 (needs virmidi)
 midikbd -o midiC1D0     # plays to Devicefile /dev/snd/midiC1D0
 midikbd -o - 1:90 0:105 | midiecho -i - -d 1 -q 40 -e 1 # to STDOUT
 midikbd 3              # plays to MIDI-Channel 3 (out of 0..15)
 midikbd 3:0:80 0:73:20     # sets Channel:Patch:Pan, plays to 0
 midikbd 3:92:x10:y1 # mouse X-motion controls pan; Y modulation
 midikbd -ka                # selects the "augmented" keymapping
 midikbd -q         # Quiet mode: doesn't display keystroke help
 perldoc midikbd

 the "piano" keymap (bottom 2 rows round middleC, top 2 treble clef):
    1    2    3        5    6       8    9    0        =   Back
 F  F# G G# A Bb B   C C# D Eb E  F F# G G# A Bb B   c c# d eb e
 Tab   q    w    e   r    t    y  u    i    o    p   [    ]    \
              s    d        g    h    j       l    ; 
            C C# D Eb  E  F F# G G# A Bb B  C C# D Eb E
            z    x     c  v    b    n    m  ,    .    /

 Q = Quit     P = change Patch      C = change Channel
 PageUp     = Up an octave   PageDown  = Down an octave
 U          = Up a semitone  D         = Down a semitone
 UpArrow    = Volume +10     DownArrow = Volume -10
 RightArrow = Pan +16        LeftArrow = Pan -16  
 F1,F2   = take new pedal    F3,F4     = remove pedal
 End     = all sounds off    Home = reset all controllers

=head1 DESCRIPTION

This script allows the use of the computer keyboard
as a simple monophonic MIDI keyboard.

In version 4.0 the command-line syntax has been made neater,
and more consistent with I<midiecho>.
The -d and -p options have been merged into -o,
and arguments are interpreted as ChannelSpecs
so the -C option has been removed.

I<Midikbd> is monophonic because of the impracticality
of detecting KeyUp and KeyDown events in an xterm.
If the <Space> bar is pressed
(or any other ascii-key which does not map to a note),
then the current note is stopped;
otherwise, each note lasts until the next note is played.

This also means that if you hold a key down (as you would on,
say, an organ keyboard) the key-repeat mechanism will start up;
this may sound, er, unexpected.

If the B<-o> option is not given then I<midikbd> writes to the
port specified by the I<ALSA_OUTPUT_PORTS> environment variable.
If that is not set, it writes directly to an ALSA raw-MIDI device (I<midiC?D?>)
that it finds in I</dev/snd/> If it finds more than one such device,
it uses I<Term::Clui> to let the user choose between them.
The only devices that appear there are
the hardware-synths and the Virtual-MIDI ports;
other ALSA-clients (e.g. I<timidity>) do not appear in I</dev/snd/>;
they can be accessed by using I<aconnect> to connect
a Virtual-MIDI port to the chosen ALSA-client, then using I<midikbd>
to play into the corresponding I</dev/snd/midiC?D?> device.
This is what the B<-o> option does for you.

If I<aconnect -oil> doesn't reveal any Virtual-MIDI ports,
you'll need to do I<modprobe snd-virmidi>
(or perhaps I<modprobe snd-card-virmidi>) on startup.

If you run out of 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

=head1 OPTIONS

=over 3

=item I<-o 128:0>

=item I<-o midiC2D0>

=item I<-o ->

The first example plays into the ALSA B<p>ort I<128:0>.
It does this by using I<aconnect> to find an unconnected Virtual-MIDI port,
which it then to connects to the desired ALSA-port;
it then plays into the Virtual-MIDI port's
corresponding raw-MIDI device (I<midiC?D?>).
When I<midikbd> exits it automatically deletes the connection
(because, for example, as long as a I<timidity> port is connected to,
then I<timidity> locks up the sound card for its own use).

This option allows I<midikbd> to use the same port-specification
as the other alsa-utils, e.g. I<aplaymidi> and I<aconnect>.
An ALSA-port is specified by its number; for port 0 of a client,
the ":0" part of the port specification can be omitted.
The port specification is taken
from the ALSA_OUTPUT_PORTS environment variable if none is given
on the command line.

The second example plays into
the ALSA raw-midi Device-File I</dev/snd/midiC2D0>

For completeness, if the device is of the form I<midi1> then
it plays into the old OSS raw-midi device I</dev/midi1>

If the device is B<-> then it plays to STDOUT, e.g.:
  midikbd -o - | midiecho -i - -d 250,450 -q 45 -e 1,2

=item I<-ka> or I<-kd> or I<-kh> or I<-kp> or I<-kw>

=item I<-k augmented> or I<-k drumkit> etc.

Selects the B<k>eymap: possible keymaps are I<augmented>, I<drumkit>,
I<harmonic>, I<piano> (the default) and I<wholetone>.
All keymappings are aimed at the US-keyboard; this could be seen as a bug.
The I<augmented> keymap is particularly good for improvisation.
The I<drumkit> keymap preselects Channel 9; in this mode,
it is pointless to change the Patch or the Transposition.
The I<harmonic> keymap is sort of inspired by accordion buttons,
and makes it very easy to play major and minor triads;
this is unfortunately not very useful as I<midikbd> is only monophonic,
which could also be seen as a bug.
The I<piano> keymap is the default.

 the "piano" keymap (bottom 2 rows round middleC, top 2 treble clef):
    1    2    3        5    6       8    9    0        =   Back
 F  F# G G# A Bb B   C C# D Eb E  F F# G G# A Bb B   c c# d eb e
 Tab   q    w    e   r    t    y  u    i    o    p   [    ]    \
              s    d        g    h    j       l    ; 
            C C# D Eb  E  F F# G G# A Bb B  C C# D Eb E
            z    x     c  v    b    n    m  ,    .    /

 the "wholetone" keymap (bottom 2 rows bass, top 2 treble):
 `    1    2   3    4    5    6    7    8    9    0    -    =   Back
 G G# A Bb B C C# D Eb E F F# G G# A Bb B c c# d  eb e f f# g g# a bb
   Tab  q    w    e    r   t    y    u    i    o     p   [    ]    \
          a    s    d    f    g    h    j   k    l    ;    '
          B_ C C# D Eb E F F# G G# A Bb B C C# D Eb E F F# G
             z    x    c   v    b    n    m    ,    .   /

 the "augmented" keymap (all 4 rows, starting from top left):
 `    1    2   3    4    5    6    7    8    9    0    -    =   Back
 Bb   C    E   G#   C    E    G#   c    e    g#   c    e    g    a
   Tab  q    w    e    r   t    y    u    i    o     p   [    ]    \
    B   C#   F    A    C#  F    A    c#   f    a     c#  f    g#   bb
          a    s    d    f    g    h    j   k    l    ;    '
          D    F#   Bb   D    F#   Bb   d   f#   bb   d    f#
             z    x    c   v    b    n    m    ,    .   /
             Eb   G    B   Eb   G    B    eb   g    b   eb

 the "harmonic" keymap (rightwards, alternate maj and min 3rds):
   1     2   3    4   5   6   7    8    9     0    -     =    Back
   Eb Bb G D Bb F D A F C A E C G  E B  G  D  B F# D  A  F# C# A
      q    w    e   r   t   y   u    i     o    p     [     ]
         a    s   d   f   g   h    j    k     l    ;     '
         F  C A E C G E B G D B F# D A  F# C# A E  C# G# E
            z   x   c   v   b   n    m     ,    .     /

 the "drumkit" keymap (for General-MIDI channel 9):
 Perc  1   2   3   4   5   6   7   8   9   0   -   =    Congas
 HiHat   q   w   e   r   t   y   u   i   o   p   [   ] Cymbals
 Snare     a   s   d   f   g   h   j   k   l   ;   '   TomToms
             z   x   c   v   b   n   m   ,   .       BassDrums

=item I<-q>

B<q>uiet mode: doesn't display keystroke help

=item I<-h>

Prints B<h>elpful usage information.

=item I<-v>

Prints B<v>ersion number.

=back

=head1 CHANNELSPEC

After the options, the remaining command-line arguments are ChannelSpecs,
which specify how the MIDI-Channels are to be set up. For example:

B< 5>

This first example preselects B<C>hannel number 5 (out of 0..15).

B< 5:91:120 4:14:120 3:91:8 2:14:8 1:91:64 0:14:64>

The second example sets up I<Channel:Patch:Pan> on a number of channels,
and leaves I<midikbd> playing on the last channel mentioned.
A list of General-MIDI Patch-numbers is at
http://www.pjb.com.au/muscript/gm.html#patch
E.g.:
  midikbd -o - 5:91:120 4:14:120 3:91:8 2:14:8 1:29:64 0:14:64 \
  | midiecho -i - -d 1,2200,2201,4400,4401 -q 5 -e 1,2,3,4,5

B< 3:91:y0 2:92:y-0 1:93:x-10 0:94:x10>

The third example uses mouse movement X,Y
within its window to drive MIDI-controllers, with an B<x> or a B<y>
followed by a Controller-number.
A list of MIDI-Controller numbers is at
http://www.pjb.com.au/muscript/gm.html#cc
and if the number is preceded by a minus sign then I<midikbd> reverses the
direction of drive, so that right- or up-motions decrease the parameter
rather than increase it as they do normally.

Controller number zero is re-interpreted by I<midikbd> to mean Pitch-Bend,
which is not technically a real MIDI-controller, but is very useful.
(The real MIDI-controller number zero is a Bank-Select, which is a
slow and discontinuous operation not useful under a mouse.)

B< midikbd -o - 3:91:y0 2:92:y-0 1:93:x-11 0:94:x11 \
  | midiecho -i - -d 1,1,1 -q 1,1,1 -e 1,2,3>

This fourth example leaves I<midikbd> transmitting
to patch 94 on channel 0, after having set patch 91 on channel 3, and 92 on 2,
and 93 on channel 1;
and the X-motions of the mouse cross-fade from patch 93 to 94,
and the Y-motions raise and lower patches 91 and 92 in opposite directions
(very wild...).

I<Midikbd> detects mouse-motion events from the I<xterm>,
by using the DECSET SET_ANY_EVENT_MOUSE command: \e[?1003h
(An earlier version ran I<xev> and parsed its output).

=head1 SUPERSEDED OPTIONS

=over 3

=item I<-p>

Specifies the output ALSA-port.  Just use B<-o> instead.

=item I<-d>

Specifies the output device-file.  Just use B<-o> instead.

=item I<-C>

Preselect the MIDI-channel.  Just specify the I<ChannelSpec> arguments
after the options on the command-line.

=item I<-P 32>

Preselects B<P>atch number 32 on whatever the current channel is.
This option is superseded by the I<ChannelSpec> arguments.

=back

=head1 CHANGES

 20100819  4.1  CursorRow set correctly for drumkit keymap
 20100419  4.0  -C deprecated, -p and -d subsumed into -o
 20100417  3.6  X and Y mouse movements govern controllers 
 20100402  3.5  F1,F2 take new pedal; F3,F4 remove pedal
 20100326  3.4  -C accepts the Channel:Patch:Pan format
 20100325  3.3  handles multiple -C nn -P nn -C nn -P nn settings
 20100325  3.2  Left&Right pan; U&D transpose, Up&Down vol
 20100318  3.1  -d -  outputs to stdout, e.g. to pipe into midiecho -i -
 20100215  3.0  -C and -P, and -p now means ALSA-port
 20100206  2.9  augmented keymapping
 20100202  2.8  uses aconnect to show "connected to" info for virmidi
 20100202  2.7  -d option
 20100130  2.6  in drumkit mode, no Channel, Patch or Transpose
 20100130  2.5  fixed -h option
 20100130  2.4  drumkit keymapping
 20100129  2.3  piano, wholetone and harmonic keymappings; -k option
 20100128  2.2  Quiet mode: doesn't display keystroke help
 20100127  2.1  display_note()
 20100127  2.0  different key2note mapping, starting from z=C
 20100126  1.9  bug fixed with note-off for bass c
 20100126  1.8  End = sounds off,  Home = reset controllers
 20100126  1.7  looks through /dev/snd for midiC* files
 20100126  1.6  remembers Patch per Channel
 20100125  1.5  proper little Clui-style state display
 20100125  1.4  Left and Right arrows change volume
 20100125  1.3  the -p option works
 20100125  1.2  sub note_off; channel change stops last note
 20100125  1.1  PageUp,PageDown,Up,Down change transpose
 20100125       P changes patch, C changes channel
 20100124  1.0  first working version

=head1 AUTHOR

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

=head1 REQUIREMENTS

Uses the CPAN module Term::ReadKey and, if there are more than
one raw-midi device present, also uses the CPAN module Term::Clui.

=head1 SEE ALSO

 Term::ReadKey
 Term::Clui
 http://www.pjb.com.au/midi
 http://www.pjb.com.au/muscript/gm.html
 http://vmpk.sourceforge.net
 perl(1).

=cut