~ubuntu-branches/ubuntu/maverick/perl-tk/maverick

#!/tools/local/perl -w

use strict;

use Tk;

my $mw  = MainWindow->new;

my @but;

my @tab;

 

use Carp;

#$SIG{__WARN__} = \&Carp::confess;

 

my $page = 0;

my $pagehex = '0x00';

my $l = $mw->Label(-text => 'Page:',-justify => 'right',-anchor => 'e');

my $s = $mw->Spinbox(-width => 4, -to => 255, -from => 0, -format => "%3.0f", -textvariable => \$page,-justify => 'left');

my $h = $mw->Label(-width => 4, -textvariable => \$pagehex, -justify => 'left');

Tk::grid($l,$s,$h);

$s->configure(-command =>\&set_page);

my $uf = $mw->fontCreate(-family => 'lucida sans', -size => 16);

my $lf = $mw->fontCreate(-family => 'courier', -size => 12);

print join(' ',$mw->fontActual($uf)),"\n";

my @h;

my @lab;

push @h,$mw->Label(-text => '');

for my $i (0x0..0xf)

 {

  my $l = $mw->Label(-text => sprintf("0x%04X",$i), -font => $lf,

          -justify => 'c', -anchor => 'c', -relief => 'ridge');

  push(@h,$l);

 }

Tk::grid(@h,-sticky => 'nsew');

for my $i (0x00..0xff)

 {

  my $s = chr($i);

  my $b = $mw->Button(-text => $s, -font => $uf, -justify => 'c', -anchor => 'c');

 

  push(@but,$b);

  push(@tab,$b);

  if ($i % 16 == 15)

   {

    my $l = $mw->Label(-text => sprintf("0x%03X",$i & 0xF0), -font => $lf,

                 -justify => 'c',  -relief => 'ridge');

    push(@lab,$l);

    Tk::grid($l,splice(@but,0,16),-sticky => 'nsew');

   }

 }

set_page($s);

$mw->update;

$mw->gridPropagate(0);

MainLoop;

 

sub set_page

{

 my ($e) = @_;

 $pagehex = sprintf("0x%02X",$page);

 for my $i (0..0xf)

  {

   $lab[$i]->configure(-text => sprintf("0x%04X",($page<<8)+($i<<4)));

  }

 for my $i (0x00..0xFF)

  {

   my $b = $tab[$i];

   my $u = ($page<<8) | $i;

   my $c = chr($u);

   my $s = $c; # "$c\n".sprintf("%02X",$i);

#  die "bug $i" unless utf8::valid($s);

   $b->configure(-text => $s);

  }

}