#!/usr/bin/perl -w
use Tk;
use Encode qw(decode);
use Encode::Guess;
use strict;

$Tk::FontRank = \&Ranker;

my $mw = MainWindow->new();
my $seln;

my $tb = $mw->Frame->pack(-fill => 'x');

my $lb = $mw->Scrolled('Listbox',-width => 40, -exportselection => 0);

my $entry = $mw->Entry->pack(-fill => 'x');

$tb->Button('-text' => "Primary Targets", '-command' => [\&ShowTargets,$lb,'PRIMARY'])->pack('-side'=>'left');
$tb->Button('-text' => "Clipboard Targets", '-command' => [\&ShowTargets,$lb,'CLIPBOARD'])->pack('-side'=>'left');
$tb->Label('-textvariable' => \$seln)->pack('-side'=>'left');
$tb->Button('-text' => "Quit", '-command' => ['destroy',$mw])->pack('-side'=>'right');

$lb->packAdjust(-expand => 1, -fill => 'both');
my $tx = $mw->Scrolled('ROText',-width => 40, -exportselection => 0, -wrap => 'none')->pack(-expand => 1, -fill => 'both');

$lb->bind('<ButtonRelease-1>',[\&GetSelected,$tx]);

ShowTargets($lb,'PRIMARY');

MainLoop;

sub GetSelected
{
 my ($lb,$tx) = @_;
 my $name = $lb->getSelected;
 if (defined $name)
  {
   $tx->insert('end',"----- $name -----\n");
   my @targ = $lb->SelectionGet('-selection'=>$seln,$name);
   if ($name eq 'text/html')
    {
     my $targ = join("", @targ);
     $targ = decode("Guess", $targ);
     $tx->insert('end', $targ);
    }
   else
    {
     foreach (@targ)
      {
       $tx->insert('end',"$_\n");
      }
    }
   $tx->see('end');
  }
}

sub ShowTargets
{
 my $lb = shift;
 $seln = shift;
 my $own =  $lb->SelectionExists('-selection'=>$seln);
 if ($own)
  {
   printf "owner of $seln is %x\n",$own;
   $lb->delete(0,'end');
   eval {
   my @targ = $lb->SelectionGet('-selection'=>$seln,'TARGETS');
   $lb->insert('end',@targ);
   foreach (@targ)
    {
     if (/FILE_NAME/)
      {
       print $lb->SelectionGet('-selection'=>$seln,'FILE_NAME'),"\n";
      }
    }
   };
  }
}

sub Ranker
{
 my ($cost,$ch,$want,$got) = @_;
 return $cost if $ch == 32;
 if ($cost == 0)
  {
   printf "U+%04x for ",$ch;
   print $want->family," use ",$got->Xname,"\n";
  }
 elsif ($cost == -1)
  {
   printf "U+%04x $ch not in ",$ch;
   print $got->Xname,"\n";
  }
 else
  {
   return (1 << 30) if ($got->size && $want->size != $got->size);
   if ($got->encoding eq 'iso10646-1')
    {
     $cost = ($cost >> 3) || 1;
    }
   printf "%08x for U+%04x ",$cost,$ch;
   print $want->family,' got ',$got->family,'/',$got->encoding,"\n";
  }
 return $cost;
}