1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
#!/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);
}
}
|
