#!/usr/bin/perl -s
our($r,$rec,$h,$debug,$fluid,$out);
use strict;
use Data::Dumper;
use IPC::Open3;
use utf8::all;
my %client;

### reset!!
# sys("killall    -q vmpk");
  sys("killall    -q qsynth");
  sys("killall -9 -q fluidsynth");
  sys("killall -9 -q jackd");
  sys("killall    -q qarecord");

### start pulseaudio if not running
  sys("pulseaudio --check || pulseaudio -D");

my $def_instrument = shift || 1 ;

my ($R,$W,$E);
my $fluidsynth = qq{fluidsynth -l -a pulseaudio -g 0.8 };
my $pid  = open3($W,$R,$E,$fluidsynth) || die("can open2");
my $current_sf={};

my $f=[   ## sf2 database
  {file => "FluidR3_GM",    chan=>[[0,0],[0,7],[0,48],[0,19],[0,22],[0,68],[128,0]], inst => qw(all)},
  {file => "Diato",         chan=>[[0,1],[0,2],[0,3],[0,4],[0,5]], inst => qw(acordeon)},
  {file => "Blanchet-1720", chan=>[[1,1],[1,2],[1,3],[1,4]], inst => qw(cravo)},
  {file => "lute",          chan=>[[0,24]], inst => qw(alaúde)},
  {file => "erans-kvist-cello_sus_f", chan=>[[0,0]], inst => qw(violoncelo)},
  {file => 'Natural_Oboe',  chan=>[[0,0]], inst => qw(oboé)},
  {file => "bongos",        chan=>[[0,0]], inst => qw(bongos)},
  {file => "drums_super_real_evandro", chan=>[[0,0]], inst => qw(tambores)},
  {file => '5334_ACCORDION',chan=>[[0,2]], inst => qw(acordeon)},
  {file => 'CampbellsHonerAccordian', chan=>[[0,1],[0,2],[0,3],[0,4],[0,5]], inst => qw(acordeon)},
  {file => '010_Music_Box', chan=>[[0,10]], inst => qw(caixa de música)},
  {file => 'nylon_guitar_1',   chan=>[[0,0],[0,1],[0,2],[0,3],[0,4],[0,5],[0,6],[0,7],[0,8],[0,9]], inst => qw(Guitarra nylon)},
  {file => 'Tenor_Sax_1',   chan=>[[0,0],[0,1],[0,2],[0,3],[0,4],[0,5],[0,6],[0,7],[0,8],[0,9]], inst => qw(Sax Tenor)},
  {file => 'TimGM6mb',  chan=>[[0,73]], inst => qw(flauta)},
];

my $i = shift // "FluidR3_GM";
my ($vip,$vop,$sp,$mtp);
my %inst = (
   corn    => 'English_Horn_2',
   diato   => 'Diato',
   orgao   => 'Orgue_de_salon',
   acordeao => '5334_ACCORDION',
   guitarc => 'acoustic_guitar_chords',
   bongo   => 'bongos',
   lute    => 'lute',
   cello   => 'erans-kvist-cello_sus_f',
   guitar  => 'nylon_guitar_1',
   piano   => 'wst25fstein_00sep22',
   FluidR3_GM   => 'FluidR3_GM',
   oboe    => 'Natural_Oboe',
   '8m'    => '8MBGMSFX',
   ti      => 'TimGM6mb',
   cravo   => 'Blanchet-1720',
   drums   => 'drums_super_real_evandro',
   sax     => 'Tenor_Sax_1',
   music_box => '010_Music_Box',
);

my $sfpath;

my @sf2dir=qw(
 .
 /usr/share/soundfonts/sf2
 /usr/share/soundfonts
 /share/soundfonts
 /usr/share/sounds/sf2/
);

if($h){
# print "!available voices: \n\t", join("\n\t",sort keys  %inst),"\n";
      for(1..@$f){print "$_ --  $f->[$_-1]{inst}: $f->[$_-1]{file}\n"}
 exit 0;
}

my $sf2 ;

$sf2=fullpath($i);

#for(@sf2dir){next unless -d $_;
#   if(-f "$_/$inst{$i}.sf2" ){$sf2 //= "$_/$inst{$i}.sf2"; $sfpath//=$_;};
#   if(-f "$_/$i.sf2"        ){$sf2 //= "$_/$i.sf2"       ; $sfpath//=$_;};
#}

die("Cant find basefont (try to install $i...where is it?)\n") unless $sf2;

if ($def_instrument =~ m{^[a-zA-Z./~].*sf2$}){
      $sf2 = $def_instrument ;
      my($ps,$ns) = get_sf2_meta($def_instrument);
      print Dumper($ps,$ns);
      my $new_sf2=@$f;
      $f->[$new_sf2]={file=>$sf2,chan=>$ps,intr=>$ns};
      $def_instrument = $new_sf2+1;
}

die("$sf2 not found\n") unless -f $sf2;

get_connections();

### if($fluid) {midiserverfl( qq{$sfpath/$inst{$i}.sf2});}
set_sf($def_instrument);

keyboard();
conets();
main_int();

kill $pid;

sub main_int{
   while(<>) {
      chomp;
      if    (/^\s*(\d+)\s*$/)       { set_sf($1,undef) } 
      elsif (/^\s*(\d+)(\!\d+)\s*$/){ set_sf($1,$2   ) } 
      elsif (/^\s*(\d+)\.(\d+)\s*$/){ set_sf($1,$2   ) } 
      elsif (/^\s*(h|help)\s*$/){ 
         for(1..@$f){print "$_ --  $f->[$_-1]{inst}: $f->[$_-1]{file}\n"}
         for(keys %$current_sf){print "$_ -loaded as- $current_sf->{$_}\n"}
      }
      else {print $W "$_\n"; } 
   }
}

sub get_connections{
  %client =();
  $vop=$vip=$sp=$mtp=0;
  my $a = sys("aconnect -i -o -l","quiet");
  print $a if $debug;
  if($a =~ /client\s*(\d+):\s*'VMPK Output/){$vop=$1}
  if($a =~ /client\s*(\d+):\s*'VMPK Input/ ){$vip=$1}
  if($a =~ /client\s*(\d+):\s*'FLUID Synth/){$sp=$1}
  if($a =~ /client\s*(\d+):\s*'Midi Through/){$mtp=$1}

  my $k;
  for ( split(/(?:^|\n)client\s*/,$a,1000)){
     if(s/^(\d+):\s*'(.*?)'//){ $k=$1;      $client{$1}{name}=$2;} else {next}
     if(s/Connect(?:ing|ed) (To|From):\s*(\S.*\S)//){ $client{$k}{$1}=$2;} else {next}
     if(s/Connect(?:ing|ed) (To|From):\s*(\S.*\S)//){ $client{$k}{$1}=$2;} else {next}
     if(s/Connect(?:ing|ed) (To|From):\s*(\S.*\S)//){ $client{$k}{$1}=$2;} else {next}
  }
  print Dumper \%client if $debug;
}

sub keyboard{
  my $sleep=1;
  my $timeout=15;
  if(not $vop) { 
     print "starting VMPK\n";
     sys ("vmpk &");
  }
  else{ print "reusing VMPK\n"; }
  get_connections();
  while(not $vop) { 
     print "sleeping $sleep\n";
     sleep $sleep;
     get_connections();
     if ($timeout < 0) { print "ERROR: VMPK timeout\n"; return;}
     $timeout -= $sleep;
  }
  print "done $vop\n";
}

sub conets{
  if(not $client{$vop}{To}) {
     if($vop and $sp){
        print "connecting VMPK to SYNth...\n";
        sys("aconnect $vop:0 $sp:0");}
     else{
        print "ERROR: cant connect VMPK to midiserver...\n";}
  }

  if(not $client{$mtp}{To}) {
     if($mtp and $sp){
        print "connecting midithrough to SYNth...\n";
        sys("aconnect $mtp:0 $sp:0");}
     else{
        print "ERROR: cant connect  to midiserver...\n";}
  }
}

sub sys{
  my $com  = shift;
  my $quit = shift || 0;
  my $r="";
  print "==> $com" unless $quit;
  if ($com =~ /\&/){ 
     system($com); 
     warn("\nError1: $!\n") if $!;
  }
  else {
     $r=`$com`;
     warn("\nError2: $!\n") if $!;
  }
  print "\n" unless $quit;
  $r;
}

sub set_sf{                ## set soundfont (sf-number, [prog for channel 0])
  my ($i,$opprog) = @_;    ## 
  my $voice ;
  if ($current_sf->{$i}) { $voice = $current_sf->{$i}                         }
  else                   { $voice = $current_sf->{$i} = (++$current_sf->{next});
#     my $sf2file= $f->[$i-1]{file};
     my $sf2file=fullpath($f->[$i-1]{file});
     print "loading font $sf2file\n"; 
     if   (-f $sf2file              ){ print $W "load $sf2file\n"; }
     elsif(-f "$sf2file.sf2"        ){ print $W "load $sf2file.sf2\n"; }
     elsif(-f "$sfpath/$sf2file.sf2"){ print $W "load $sfpath/$sf2file.sf2\n"; }
     else{ warn("cant find $sf2file\n");}
  }

  preset($i,$voice,$opprog);
}

sub preset{ my($i,$voice,$prog)=@_;
  my @l=@{$f->[$i-1]{chan}};
  my $n = 0;
  if($prog =~ m{!(\d+)}){
     print "##### select 0 $voice 0 $1\n";
     print $W    "select 0 $voice 0 $1\n";
  }
  elsif($prog){
     print "##### select 0 $voice $l[$prog][0] $l[$prog][1]\n";
     print $W "select 0 $voice $l[$prog][0] $l[$prog][1]\n";
  }
  else {
     for (0..@l-1){
       print $W "select $_ $voice $l[$_][0] $l[$_][1]\n";
     }
  }
  print $W "help batatas\n";
   my $co=100; 
   while(($a=<$R>) !~ /help help/ and $co) {
     next if $a =~ m{^\n
          |swapping\ is\ possible
          |No\ preset\ found
          |FluidSynth\ version
          |Distributed\ under
          |Copyright
          |registered\ trademark
          |batatas
          |help\ topic}x;
        chomp $a; print "{$a}\n";
        $co--;
   }
   warn($a) unless $co;
   #   chomp $a; print "{$a}+\n";
}

sub get_sf2_meta{ my $f=shift;
   my $meta = `sf2text $f| grep preset `;
   my $ps=[];
   my $ns=[];
   while( $meta =~ m{\(\s*(\d+)\s*"(.*?)"\s*\(preset\s*(\d+)\)\s*\(bank\s*(\d+)\)}g ){
     my($i,$name,$preset,$bank)=($1,$2,$3,$4);
     last if $name eq "EOP";
     push(@$ps,[$bank,$preset]);
     push(@$ns,$name);
   }
   ($ps,$ns); 
}

sub fullpath{
  my $i=shift;
  my $sf2 ;
  for(@sf2dir){next unless -d $_;
     if(-f "$_/$inst{$i}.sf2" ){$sf2 //= "$_/$inst{$i}.sf2"; $sfpath//=$_;};
     if(-f "$_/$i.sf2"        ){$sf2 //= "$_/$i.sf2"       ; $sfpath//=$_;};
  }
  return $sf2;
}

__END__

  {file => "pianoChords",   chan=>[[0,0],[0,1],[0,2],[0,3]], inst => qw(acordes M piano)},
  {file => 'GT_JazzDrums',  chan=>[[0,0]], inst => qw(perc jaz)},