Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Tk version Geek clock

by Gorilla (Sexton)
on Jan 01, 2003 at 06:07 UTC ( #223543=perlquestion: print w/ replies, xml ) Need Help??
Gorilla has asked for the wisdom of the Perl Monks concerning the following question:

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

Comment on Tk version Geek clock
Download Code
Re: Tk version Geek clock
by pg (Canon) on Jan 01, 2003 at 06:53 UTC
    Tk is event driven, and MainLoop handles all the events. One type of events can be handled by MainLoop is called timer event. You don't need sleep, you don't need alarm. Tk provides you a way to schedule timer event.

    Just delete that Button, as you don't need it any more, and right before MainLoop, add this line:
    $mw->repeat(1000 => \&refresh);
    It should work. Let your Geek Clock bring you into 2003.
Re: Tk version Geek clock
by {NULE} (Hermit) on Jan 02, 2003 at 00:02 UTC
    Hi there,

    pg is completely correct - look up Tk::after - using after or repeat is the way to do this. But on a side note, if your program is not going to be interactive you don't *need* to use MainLoop.

    (I don't know why I'm mentioning this - I have a bad habit of bringing up the Wrong Way To Do It, just because I think it's interesting. I can feel the -- already.)

    Instead of calling MainLoop you can write you own loop at the end that looks something like this:

    while (1) { &refresh; $mw->update; sleep 1; }
    But don't do that! The only good excuse that I can think of for doing something like this is if you want to popup a Tk status bar as your MainWindow while a script is doing something in the background (like parsing a really big file). In that case you don't need the interaction and the user is just sitting there and waiting for your script to stop running anyway.

    By the way - I applaud your use of strict (and presumably warnings), but even with your my scoping your @blocks array is still being treated as a global. My preference is to pass a reference to you array around instead of just implying that you mean to use it globally.

    What I like to do is create a $w hash and a $s hash and fill them with widgets and state information, then pass them to functions or Tk callbacks via reference. Of course, that is just a poor-persons form of OO, and works fine for simple scripts. This is what I mean:

    use strict; use warnings; use Tk; my $widgets = {}; $widgets->{main} = MainWindow->new; $widgets->{button} = $widgets->{main}->Button( -text => "Whatever you do - don't push me", -command => [ \&callme, $widgets ] )->pack; MainLoop; sub callme { my $w = shift; $w->{main}->configure(-title => 'How dare you push me!'); # Anything else in the $widgets hash is available here # too - handy if you have lots of widgets you need to # control from your functions or methods. }
    Anyway - just some food for thought. TMTOWTDI.
    {NULE}
    --
    http://www.nule.org

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://223543]
Approved by gjb
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (11)
As of 2014-10-24 20:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (137 votes), past polls