#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use MIME::Base64 qw( encode_base64 decode_base64 );
use Crypt::CBC;

my $mw=tkinit;
my $tl;

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

my $getp = $mw->Button(
                 -text=>'Get Password',
                 -font => 'big',
                 -bg => 'yellow',
                 -activebackground => 'hotpink',
                 -command => \&build_keyboard,
          )->pack(-expand=>1,-fill=>'x', -padx=> 5);

MainLoop;

sub build_keyboard{

 if ( !Exists( $tl ) ) {
   $tl = $mw->Toplevel();
   $tl->title( "Virtual Keyboard" );

#prevents $tl from destroying on window manager close                 
+                 
$tl->protocol('WM_DELETE_WINDOW' => sub {                             
+                
       $tl->withdraw; });

# an 8 x 13 grid
my @keys = (
'~','`','!','@','#','$','%','^','&','*','(',')','_',    
'1','2','3','4','5','6','7','8','9','0','-','+','=',  
'Q','W','E','R','T','Y','U','I','O','P','{','}','"', 
'q','w','e','r','t','y','u','i','o','p','[',']','\'',
'A','S','D','F','G','H','J','K','L',':','|','\\','/',
'a','s','d','f','g','h','j','k','l',';','<','>','?', 
'Z','X','C','V','B','N','M','BackSpace','dummy','dummy','dummy','dummy
+','dummy',
'z','x','c','v','b','n','m','.','Space','Clear','dummy','dummy','dummy
+');

 my $tframe = $tl->Frame()->pack(-expand=>1,-fill=>'both');   
 my $passwd = '';
 my $label = $tframe->Label(-text => "Password: ",
                            -font => 'big',
 )->pack(-side=>'left');
 
 my $entry = $tframe->Entry(
         -show => '*',
         -textvariable => \$passwd,
         -bg => 'black',
         -fg => 'white',
         -font => 'big',
         )->pack(-side=>'left',-expand=>1,-fill=>'x', -padx=> 5);

 my $submit = $tframe->Button(
                 -text=>'Submit',
                 -font => 'big',
                 -bg => 'yellow',
                 -activebackground => 'hotpink',
                 -command => [\&submit,$entry],
          )->pack(-side=>'right',-expand=>1,-fill=>'x', -padx=> 5);


 for my $row (1..8){
    my $frame = $tl->Frame()->pack(-expand=>1,-fill=>'both');   
   
   for my $col (1..13){
     my $l = shift @keys;
     if($l eq 'dummy'){next}else{
          $frame->Button(-text=> $l,
               -bg => 'beige',
               -activebackground => 'lightyellow',
               -font => 'big',
               -command => [\&process_key, $l,\$passwd ],
                 )->pack(-side=>'left',-anchor=>'w', -expand=>1,-fill=
+>'both');   
          
      }
   }
 
 }


  }
  else {
   $tl->deiconify();
   $tl->raise();
 }

}

#####################
sub process_key{
  my $key = shift;
  my $passwd_ref = shift;
  #print "$key\n";
  if ($key eq 'Clear'){$$passwd_ref = '';}
  elsif ($key eq 'BackSpace'){ chop $$passwd_ref;}
  elsif ($key eq 'Space'){ $$passwd_ref .= ' '; }
  else{ $$passwd_ref .= $key;}
}
#####################
sub submit {
 my $entry = shift;
 
#print $entry->get(),"\n";
#my $string = 'yadda yadda yadda yadda';
#print "$string\n";
#my $enc = encryptString( $string );
#print $enc,"\n";
#my $enc64 = encode_base64($enc);
#print $enc64,"\n";

#help avoid prying eyes by storing in encoding
my $enc64 = 'UmFuZG9tSVaifEsw5ZfchSwgyXj0JSxm5UoAgAcwrvX1MQeuK41kow=='
+;
if( $entry->get() eq decryptString(decode_base64($enc64)) ){

     $entry->delete(0,'end');
     $tl->withdraw;  # save the keyboard for reuse, so second use is f
+aster

     $mw->messageBox(
           -icon => 'warning',
           -message => 'You are in Mr. Phelps',
           -type => 'OK'
         );

 
 }else{
 
     $mw->messageBox(
           -icon => 'error',
           -message => 'Wrong Guess Try Again',
           -type => 'OK'
         );
  
     $entry->delete(0,'end');
  }
}
############################################################
sub encryptString {
   my $string = shift;

#my $KEY = 'secret_foo';
#hex of $KEY 
my $KEY = join '', map { chr } (0x73, 0x65, 0x63, 0x72, 0x65, 0x74, 0x
+5f, 0x66, 0x6f, 0x6f);
 
   my $cipher = Crypt::CBC->new(
      -key        => $KEY,
      -cipher     => 'Blowfish',
      -padding  => 'space',
      -add_header => 1
   );

   my $enc = $cipher->encrypt( $string  );
   return $enc; 
}

###################################################################

sub decryptString {
   my $string = shift;
   my $KEY = join '', map { chr } (0x73, 0x65, 0x63, 0x72, 0x65, 0x74,
+ 0x5f, 0x66, 0x6f, 0x6f);

   my $cipher = Crypt::CBC->new(
      -key        => $KEY,
      -cipher     => 'Blowfish',
      -padding  => 'space',
      -add_header => 1
   );

   my $dec = $cipher->decrypt( $string  );
   return $dec; 
}