#!/usr/bin/perl -s
our($r,$c);
use warnings;
use strict;
use utf8;
use Tk;
binmode(STDOUT,":utf8");

use Audio::Data;
use Audio::Play;
my ($svr, @nomes, @escala, %h, %n, $k, $out, $header,$co,$n
);

sub init{
 $svr = Audio::Play->new  or die ("cant open audio\n"); 
 @nomes= split(/ +/,q(f, f#, g, g#, a, a#, b, c c# d d# e f f# g g# a a# b C C# D D# E F));
 @escala = (split("","%?<azsxcfvgbnjmk,l.-[\$r&@")); 
 @h{@escala}=(1 .. @escala);
 @n{@escala}=@nomes;
 $k=1.0594630943593;  
 if (not defined $c)      {$co = [4,4];}
 elsif($c =~ m!(\d)/(\d)!){$co = [$1,$2];}
 else                     {$co = [4,4]; }
 $header = "X:1\nM:$co->[0]/$co->[1]\nQ: 1/4=60\nL:1/4\nK:C";
}

sub ppl{
 my $key=lc(shift);
 #$out .= i(($n-$last)*8/$qt). " $n{$key}";
 $out .= "$n{$key}";
 #$last=$n;
 my $a = Audio::Data->new(
       rate=> 16000, 
       silence => 0.001);
 $a->tone(320*( $k**($h{$key}-1)), 0.06, 0.3  );
 $svr->play($a);
 $svr->flush;
 #$n+=61;
}

sub bip{
 my $t=shift;
 my $a = Audio::Data->new(
       rate=> 16000, 
       silence => 0.001);
 if($t != 0 ) { $a->tone(220*22,0.01,0.3); $out .= " | "; }
 else         { $a->tone(220*28,0.01,0.3); $out .= " ";   }
 $svr->play($a);
 $svr->flush;
}

my (@keys1,@keys2);
sub lscale{
#  @keys1 = ( '_Q','W','E','_ ','T','Y','U','_ ','O','P','_+');
  @keys1 = (split("=",'_ =] =A=S=_ =F=G=_ =J=K=L=_ =[ =& '));
  @keys2 = (split("=","%^=<=Z=X=C=V=B=N=M=,=.=-=\$ =@^")); 
}

sub rscale{
  @keys1 = ( 'Q','W','E','_R','T','Y','_U','I','O','P','_+');
  @keys2 = ( 'A','S','D','F','G','H','J','K','L','Ç','[',);
}
init();
if($r){rscale}else{lscale}

sub trkey{
 my $a=shift;
 if   ($a eq "Ç"){ return "ccedilla";}
 elsif($a eq "+"){ return "plus";}
 elsif($a eq "&"){ return "ampersand";}
 elsif($a eq "%"){ return "percent";}
 elsif($a eq "<"){ return "less";}
 elsif($a eq ","){ return "comma";}
 elsif($a eq "."){ return "period";}
 elsif($a eq "-"){ return "minus";}
 elsif($a eq "@"){ return "at";}
 elsif($a eq "\$"){ return "dollar";}
 elsif($a eq "]"){ return "bracketright";}
 elsif($a eq "["){ return "bracketleft";}
 elsif($a eq "~"){ return "dead_tilde";}
 else            { return lc($a)};
}

my $mw=tkinit;

$mw->fontCreate('big',-family=>'arial',-weight=>'bold', -size=>int(-20*18/14));

my $tframe = $mw->Frame()->pack(-expand=>1,-fill=>'both');   
my $passwd = '';
 
my $entry;

my $submit = $tframe->Button(
     -text=>'<<',
     -command => \&submit,
   )->pack(-side=>'left',-fill=>'x');

$submit = $tframe->Button(
     -text=>'>>',
     -command => \&submit,
   )->pack(-side=>'right',-fill=>'x');

my $frame = $mw->Frame()->pack(-expand=>1,-fill=>'both');   
   
  for my $l (@keys1){
     my $bem = 0;
     my $show = $l;
     if    ($l =~ s/_(.)(.)/$1/){ $show=$2; $bem = 1;}
     elsif ($l =~ s/_(.)/$1/)   { $show=$1; $bem = 1;}
     elsif ($l =~ s/(.)(.)/$1/) { $show=$2;          }
     my $bbb= $frame->Button(
       ($bem 
        ? ( -text=> "\n$show", -fg => "black", )
        : ( -text=> "\n$show", -bg => 'black', -fg => 'white', 
              -activebackground => 'gray', -command => [\&process_key, $l],)),
       -font => 'big',
       -width => 1.4,);
     $bbb->pack(-side=>'left',-anchor=>'w', -expand=>0,-fill=>'both');
     $mw->bind("<KeyPress-".trkey($l).">" => sub{
        $bbb->Enter;  $bbb->Invoke }) unless $bem;
     $mw->bind("<KeyRelease-".trkey($l).">" => sub{
        $bbb->butUp; $bbb->Leave; }) unless $bem;
  }
  $frame = $mw->Frame()->pack(-expand=>1,-fill=>'both',-padx=> 18);   
  for my $l (@keys2){
     my $show = $l;
     if ($l =~ s/(.)(.)/$1/){$show=$2;}
     my $bbb= $frame->Button(-text=> "\n$show",
        -bg => 'white',
        -font => 'big',
        -width => 1.4,
        -command => [\&process_key, $l],);
     $bbb->pack(-side=>'left',-anchor=>'w', -expand=>1,-fill=>'both');
     $mw->bind("<KeyPress-".trkey($l).">" => sub{
        $bbb->Enter;  $bbb->Invoke });
     $mw->bind("<KeyRelease-".trkey($l).">" => sub{
        $bbb->butUp; $bbb->Leave; });
  }
  $mw->bind("<KeyPress-BackSpace>"=> sub{ $out .= " <del>"; });
  $mw->bind("<KeyPress-Return>"   => sub{ $out .= " |"; });
  $mw->bind("<KeyPress-q>"        => sub{aftermain();Tk::exit ; });
  $mw->repeat(800,sub{ bip($n);$n=($n+1)% ($co->[1]);print "$n."});
keybalt(1);
MainLoop;
aftermain();

sub aftermain{
 keybalt(0);
 print "$header\n$out\n";
}

#####################
sub process_key{
  my $key = shift;
  print "=$key ", $n{lc($key)},"\n";
  ppl($key);
  if ($key eq 'Clear'){$passwd = '';}
  elsif ($key eq 'BackSpace'){ chop $passwd;}
  else{ $passwd .= $key;}
}
#####################
sub submit {
 print $entry->get(),"\n";
 $entry->delete(0,'end');
}

sub keybalt{
  my $k1={
    23 => "exclam",     #tab
    35 => "equal",
    50 => "percent",    #1
    51 => "ampersand",  #3
    62 => "dollar",     #2
    98 => "at Up",      #4
    117 => "Up",
    };

  my $k2={
    23 => "Tab ISO_Left_Tab",
    35 => "dead_acute dead_grave dead_tilde dead_macron",
    50 => "Shift_L",
    51 => "dead_tilde dead_circumflex",
    62 => "Shift_R",
    98 => "Up",
    };

  if($_[0]){
    system ("xmodmap -e 'remove Shift = 50' -e 'remove Shift = 62' ".
         join(" ",map {"-e 'keycode $_ = $k1->{$_}'"} keys %$k1));
  }
  else {
    system ("xmodmap -e 'add Shift = 50' -e 'add Shift = 62' ".
         join(" ",map {"-e 'keycode $_ = $k2->{$_}'"} keys %$k2));
  }
}


__END__

use Text::RewriteRules;
use Term::ReadKey;
our($c,$m,$keyb);
my $qt = $m || 600;
my $co = [4,4];
$keyb ||= 2;
$|=1;

my $outputfile = shift || "_out";
open(F,">$outputfile") or die("can open $outputfile\n");

if ($keyb == 1){ binmode(STDIN,":utf8");
      @escala = (split("","awsedftgyhujkolpç[")); }
elsif ($keyb == 2){ binmode(STDIN,":utf8");

}
else{ @escala = (split("","<azsxcfvgbhnmk,l.-")); }


# for (@escala){ print ("$_  =  $n{$_} = $h{$_}\n"); }

# C1 * k^12 = C2     => 
# k ^12 = 2          => 
# log(k)*12 = log(2) => 
# log(k) = log(2)/12 =>
# k = exp(log(2)/12) =>

my $t=0;
my $n1=0;
my $n=0;
my $last=0;

ReadMode 4; # Turn off controls keys

while (($key = ReadKey(0.001)||"") ne "q"){
  $n++;
  if ($key)         { 
    if($key =~ /[\s]\?\?\?\?/){ warn("??$key\n") }
    else
  }
  else{
      $n++ ;
      select(undef,undef,undef,0.001);
  }
  if ($n > $n1) { 
       $n1 += $qt;
       my $a = Audio::Data->new(rate=> 8000, silence => 0.001);
       if($t++ % $co->[0] == 0 ) { 
           $a->tone(220*22,0.01,0.3);
           $out .=  i(($n-$last)*8/$qt). "|";
           $last=$n;
       }
       else { $a->tone(220*28,0.01,0.3); }
       $svr->play($a);
       $svr->flush;
       $n += 11;
  }
}

 my $rr1 = toabc($out);
 my $rr2 = ff($rr1);
 print F "$header\n$rr2\n";
 print "$header\n$rr2\n";
 keybalt(0);
 ReadMode 0; # Reset tty mode before exiting

sub i{ int($_[0]+0.5); }

RULES/m toabc
\|[012]==>|
([^\|])([012])\s*\|(\d+)==>|$1$3!! $3 >= 4
(.)==>$1
(\n)==>$1
ENDRULES

RULES/m ff
(11|12|13|14)==>3/2
(15|16|17|18)==>2
(24|23|25|22|26)==>3
(30|31|32)==>4
(7|8|9)==>1
(10|21|19|20|2)==>?
(6)==>3/4
(3|4|5)==>/2
(.|\n)==>$1
ENDRULES