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"); } } }