Be aware that perlTk with Unicode support is currently in beta stage.

I can share a program written for WinCE devices (hence strange geometry) that uses Tcl::Tk and provides English/Korenan/Japanese/Chinese dictionary searching (Japanese, Chinese taken from Monash university, thanks them!)
Also it allows searching in Unihan database.

use strict;

$::unipath='\storage card\unicode';
#my %uniexcl = ();

my $o='5669';
my $last=0;

use Tcl::Tk qw/:perlTk/;
my $mw=tkinit;
my $int=$mw->interp;
my $lfont = "-*-Arial Unicode MS--R---*-300-*-*-*-*-*-*";
my $cfont = "-*-Arial Unicode MS--R---*-200-*-*-*-*-*-*";
my $mfont = "-*-Arial Unicode MS--R---*-100-*-*-*-*-*-*";
my $tw=$mw->Text(-wrap=>'char',-font=>$cfont,-height=>4,-width=>20)->p
+ack;
$tw->tagConfigure('large',-font=>$lfont);
$tw->tagConfigure('descr',-font=>$mfont,-foreground=>'blue4');
$tw->tagConfigure('def',-font=>$mfont,-foreground=>'red4');
my $fbot=$mw->Frame()->pack;
my $ew=$fbot->Entry(-font=>$mfont,-textvariable=>\$o,-width=>10)->pack
+(-side=>'left');
my ($gdef,$ghier)=('','');
#my $e1w=$fbot->Entry(-font=>$lfont,-textvariable=>\$ghier,-width=>3)-
+>pack(-side=>'left');
my $e2w=$fbot->Entry(-font=>$mfont,-textvariable=>\$gdef)->pack(-side=
+>'left');
my $fr=$mw->Frame()->pack;
my $bw=$fr->Button(-text=>'test',
  -command=>sub{
  $tw->insert('insert',eval qq/"\\x{$o}"/);
})->pack(-side=>'left');

my $bschw=$fr->Button(-text=>'search',
  -command=>sub{
    my ($r,$what)=($tw->get('insert','insert + 1 chars'),'');
    if ($r eq '+') {
      $what=$tw->get('insert + 1 chars','insert + 5 chars');
    }
    else {
      #use Devel::Peek;
      #Dump($r);
      use Encode;
      Encode::_utf8_on($r);# will go away once Tcl bug will be fixed
      #Dump($r);
      $what=unpack("H*",encode('ucs2',$r));
    }
#print STDERR qq/=$what=\n/;
    $ghier = eval qq/"\\x{$what}"/;
    $tw->insert('end',"$ghier\n",'large');
    $tw->insert('end',$_,/kDefinition/i?'def':'descr')
      for lookup_unihan($what);
})->pack(-side=>'left');
my $bscodew=$fr->Button(-text=>'(#)',
  -command=>sub{
    my $what=$o;
    $tw->insert('end',eval qq/"\\x{$what}\n"/);
    $tw->insert('end',$_,/kDefinition/i?'def':'descr')
      for lookup_unihan($what);
})->pack(-side=>'left');
my $blookupj=$fr->Button(-text=>'l-J',
  -command=>sub{
    my $what=quotemeta $o;
    unless (defined $::jmdict) {
      open my $fhjm, "<$::unipath\\tkjmdict-0.94\\jmdict_en.bin";
      binmode $fhjm;
      local $/;
      $::jmdict=<$fhjm>;
    }
    while ($::jmdict=~/^.*?$what.*?$/img) {
      my ($t0,$t1)=($-[0],$+[0]);
      $tw->insert('end',substr($::jmdict,$t0,$t1-$t0).qq/\n/,'descr');
      $int->update;
    }
  })->pack(-side=>'left');
my $blookupch=$fr->Button(-text=>'l-CH',
  -command=>sub{
    my $what=quotemeta $o;
    unless (defined $::chdict) {
      open my $fhch, "<$::unipath\\CHIN\\cedict.utf8";
      binmode $fhch;
      local $/;
      $::chdict=<$fhch>;
    }
    while ($::chdict=~/^.*?$what.*?$/img) {
      my ($t0,$t1)=($-[0],$+[0]);
      $tw->insert('end',substr($::chdict,$t0,$t1-$t0).qq/\n/,'descr');
      $int->update;
    }
})->pack(-side=>'left');
my $blookupch=$fr->Button(-text=>'l-KR',
  -command=>sub{
    my $what=quotemeta $o;
    unless (defined $::krdict) {
      open my $fhkr, "<$::unipath\\korean\\kor2eng.ut8";
      binmode $fhkr;
      local $/;
      $::krdict=<$fhkr>;
    }
    while ($::krdict=~/^.*?$what.*?$/img) {
      my ($t0,$t1)=($-[0],$+[0]);
      $tw->insert('end',substr($::krdict,$t0,$t1-$t0).qq/\n/,'descr');
      $int->update;
    }
})->pack(-side=>'left');
my $bclr=$fr->Button(-text=>'clear',-command=>sub{
   $tw->delete('1.0','end');
 })->pack(-side=>'left');
my $bgen=$fr->Button(-text=>'gen_idx',
  -command=>sub{
    0 && do_idx();
  })->pack(-side=>'left');
my $cnt=0;

sub do_idx {
  if(!$last){
    $o='Testing... done!';
    return;
  }
  open my $fh, "<$::unipath\\unihan.txt";
  binmode $fh;
  open my $fhoidx, ">$::unipath\\unihan-idx.idx";
  binmode $fhoidx;
  my $lo='';
  my ($fpos,$fpos0)=(0,0);
  while(<$fh>) {
    $fpos=$fpos0;
    $fpos0=tell $fh;
    if (/^u\+(\w+)/i) {
      next if $1 eq $lo;
      $lo=$1;$o=$1;
      $int->update;
      printf $fhoidx "%4s%08d\n",$lo,$fpos;
#  $tw->insert('end',eval qq/"\\x{$lo}"/);
      while(<$fh>=~/^u\+$o/io){
#       print "$_";
      }
    }
    last if $last;
  #last if ++$cnt>100000;
  #  $int->update;
  }

}

$int->MainLoop;

#
# look up in unihan database.
# reads index file if necessary
sub lookup_unihan {
  my $what=shift;
  unless (defined $::idx) {
    open my $fhiidx, "<$::unipath\\unihan-idx.idx";
    binmode $fhiidx;
    local $/;
    $::idx=<$fhiidx>;
  }
  $::idx=~/^$what(.*?)$/im;
  open my $fh, "<$::unipath\\unihan.txt";
  binmode $fh;
  seek $fh, $1, 0;
  my @res;
  while (local $_ = <$fh>) {
    last unless /^u\+$what/i;
    s/\t/ /g;
    push @res, $_;
  }
  return @res;
}
[download]

Courage, the Cowardly Dog