1#!/tools/local/perl -w
2use strict;
3use Tk;
4my $mw  = MainWindow->new;
5my @but;
6my @tab;
7
8use Carp;
9#$SIG{__WARN__} = \&Carp::confess;
10
11my $page = 0;
12my $pagehex = '0x00';
13my $l = $mw->Label(-text => 'Page:',-justify => 'right',-anchor => 'e');
14my $s = $mw->Spinbox(-width => 4, -to => 255, -from => 0, -format => "%3.0f", -textvariable => \$page,-justify => 'left');
15my $h = $mw->Label(-width => 4, -textvariable => \$pagehex, -justify => 'left');
16Tk::grid($l,$s,$h);
17$s->configure(-command =>\&set_page);
18my $uf = $mw->fontCreate(-family => 'lucida sans', -size => 16);
19my $lf = $mw->fontCreate(-family => 'courier', -size => 12);
20print join(' ',$mw->fontActual($uf)),"\n";
21my @h;
22my @lab;
23push @h,$mw->Label(-text => '');
24for my $i (0x0..0xf)
25 {
26  my $l = $mw->Label(-text => sprintf("0x%04X",$i), -font => $lf,
27          -justify => 'c', -anchor => 'c', -relief => 'ridge');
28  push(@h,$l);
29 }
30Tk::grid(@h,-sticky => 'nsew');
31for my $i (0x00..0xff)
32 {
33  my $s = chr($i);
34  my $b = $mw->Button(-text => $s, -font => $uf, -justify => 'c', -anchor => 'c');
35
36  push(@but,$b);
37  push(@tab,$b);
38  if ($i % 16 == 15)
39   {
40    my $l = $mw->Label(-text => sprintf("0x%03X",$i & 0xF0), -font => $lf,
41                 -justify => 'c',  -relief => 'ridge');
42    push(@lab,$l);
43    Tk::grid($l,splice(@but,0,16),-sticky => 'nsew');
44   }
45 }
46set_page($s);
47$mw->update;
48$mw->gridPropagate(0);
49MainLoop;
50
51sub set_page
52{
53 my ($e) = @_;
54 $pagehex = sprintf("0x%02X",$page);
55 for my $i (0..0xf)
56  {
57   $lab[$i]->configure(-text => sprintf("0x%04X",($page<<8)+($i<<4)));
58  }
59 for my $i (0x00..0xFF)
60  {
61   my $b = $tab[$i];
62   my $u = ($page<<8) | $i;
63   my $c = chr($u);
64   my $s = $c; # "$c\n".sprintf("%02X",$i);
65#  die "bug $i" unless utf8::valid($s);
66   $b->configure(-text => $s);
67  }
68}
69