Monks, I made a Tk version Geek Clock. I have a problem with the last bit, as alarm does not work on windows 98, I cannot make it tick, and have to click a button to refresh.
Put sleep in a while loop also does not work, as Tk has its own infinite loop, that MainLoop. I cannot make it go into both loops.
Can some one fix my Geek Clock?
use Tk;
use threads;
use strict;
use constant BLOCK_WIDTH => 5;
use constant BLOCK_PAD => 1;
my @binary = ([0,0,0,0],
[0,0,0,1],
[0,0,1,0],
[0,0,1,1],
[0,1,0,0],
[0,1,0,1],
[0,1,1,0],
[0,1,1,1],
[1,0,0,0],
[1,0,0,1]);
my @labels = ("Hour", "Minute", "Second");
my $mw = MainWindow->new(title => "Geek Clock");
my @frames;
my @blocks;
my $digit_index;
my $binary_index;
for ($digit_index = 0; $digit_index < 6; $digit_index ++) {
$frames[$digit_index] = $mw->Frame()
->pack(padx => BLOCK_PAD,
side => "left");
for ($binary_index = 0; $binary_index < 4; $binary_index ++) {
$blocks[$digit_index][$binary_index]
= $frames[$digit_index]->Label(width => BLOCK_WIDTH,
height => BLOCK_WIDTH,
background=> "red")
->pack(pady => BLOCK_PAD,
side => "top");
}
}
$mw->Button(text => "refresh", command => \&refresh)->pack;
MainLoop;
sub refresh {
my ($second, $minute, $hour) = localtime();
display_time(sprintf("%02d%02d%02d", $hour, $minute, $second));
}
sub display_time {
my $time_string = shift;
my $index;
for ($index = 0; $index < 6; $index ++) {
display_digit($index, substr($time_string, $index, 1));
}
}
sub display_digit {
my ($index, $digit) = @_;
my $binary = $binary[$digit];
my $pos;
for ($pos = 0; $pos < 4; $pos ++) {
if ($binary[$digit]->[$pos]) {
$blocks[$index][$pos]->configure(-background => "red");
} else {
$blocks[$index][$pos]->configure(-background => "green");
}
}
}