pashanoid has asked for the wisdom of the Perl Monks concerning the following question:

Dear Bretheren, there is this great example in Tcl/Tk of a timer. Can someone help me do this in Perl::Tk? 

#!/bin/sh
# the next line restarts using wish \
exec wish8.5 "$0" "$@"

# timer --
# This script generates a counter with start and stop buttons.
#
# RCS: @(#) $Id: timer,v 1.4 2003/09/30 14:54:30 dkf Exp $

package require Tcl 8.4
package require Tk

label .counter -text 0.00 -relief raised -width 10 -padx 2m -pady 1m
button .start -text Start -command {
    if {$stopped} {
        set stopped 0
        set startMoment [clock clicks -milliseconds]
        tick
        .stop configure -state normal
        .start configure -state disabled
    }
}
button .stop -text Stop -state disabled -command {
    set stopped 1
    .stop configure -state disabled
    .start configure -state normal
}
pack .counter -side bottom -fill both
pack .start -side left -fill both -expand yes
pack .stop -side right -fill both -expand yes

set startMoment {}

set stopped 1

proc tick {} {
    global startMoment stopped
    if {$stopped} {return}
    after 50 tick
    set elapsedMS [expr {[clock clicks -milliseconds] - $startMoment}]
    .counter config -text [format "%.2f" [expr {double($elapsedMS)/100
+0}]]
}

bind . <Control-c> {destroy .}
bind . <Control-q> {destroy .}
focus .

# Local Variables:
# mode: tcl
# End:

[download]

Replies are listed 'Best First'.
Re: A timer in Tcl/Tk in Perl::Tk
by zentara (Cardinal) on Feb 10, 2012 at 09:29 UTC
    See How to implement a timer in perl?, and ...... 
    #!/usr/bin/perl -w
#
# This script generates a counter with start and stop buttons.  Exit w
+ith
# Ctrl/c or Ctrl/q.
#
# This a more advanced version of `timer', where we conform to a stric
+t style
# of Perl programming and thus use lexicals.  Also, the counter is upd
+ated via
# a -textvariable rather than a configure() method call.
#
# Tcl/Tk -> Perl translation by Stephen O. Lidie.  lusol@Lehigh.EDU  9
+6/01/25

require 5.002;
use Tk;
use strict;
sub tick;

my $MW = MainWindow->new;
$MW->bind('<Control-c>' => \&exit);
$MW->bind('<Control-q>' => \&exit);

# %tinfo:  the Timer Information hash.
#
# Key       Contents
#
# w         Reference to MainWindow.
# s         Accumulated seconds.
# h         Accumulated hundredths of a second.
# p         1 IIF paused.
# t         Value of $counter -textvariable.

my(%tinfo) = ('w' => $MW, 's' => 0, 'h' => 0, 'p' => 1, 't' => '0.00')
+;

my $start = $MW->Button(
    -text         => 'Start',
    -command      => sub {if($tinfo{'p'}) {$tinfo{'p'} = 0; tick}},
);

my $stop = $MW->Button(-text => 'Stop', -command => sub {$tinfo{'p'} =
+ 1;});

my $counter = $MW->Label(
    -relief       => 'raised',
    -width        => 10,
    -textvariable => \$tinfo{'t'},
);

$counter->pack(-side => 'bottom', -fill => 'both');
$start->pack(-side => 'left', -fill => 'both', -expand => 'yes');
$stop->pack(-side => 'right', -fill => 'both', -expand => 'yes');

sub tick {

    # Update the counter every 50 milliseconds, or 5 hundredths of a s
+econd.

    return if $tinfo{'p'};
    $tinfo{'h'} += 5;
    if ($tinfo{'h'} >= 100) {
    $tinfo{'h'} = 0;
    $tinfo{'s'}++;
    }
    $tinfo{'t'} = sprintf("%d.%02d", $tinfo{'s'}, $tinfo{'h'});
    $tinfo{'w'}->after(50, \&tick);

} # end tick

MainLoop;

    [download]
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]

      This is great! Just one last thing... How would you implement a "Clear" or "Reset" button in this code?

[reply]
        Just one last thing... How would you implement a "Clear" or "Reset" button in this code?

        How would you? This isn't a code writing service, we just point the way. :-)

        As mentioned in that script, it could be done better, with a single button for start/stop, using $button->configure() to toggle the buttons text and function. To clear it back to zero, from first glance, it looks like the timer data is stored in -textvariable => \$tinfo{'t'}, so zero out $info{'t'} or possibly all of %info's keys.

        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh
[reply]
Re: A timer in Tcl/Tk in Perl::Tk
by bcarroll (Pilgrim) on Feb 10, 2012 at 13:31 UTC
    I like zentara's code more... but here is my rendition of the script you provided converted to perl/Tk... 
    use warnings;
use strict;
use Tk;
use Time::HiRes qw(time);

my ($counter,$timerBtn,$resetBtn,$startMoment,$timer);

my $counterText = '0.00';
my $elapsedMS = 0;
my $stopped = 1;
my $mw = tkinit();
$counter = $mw->Label(
    -textvariable => \$counterText,
    -relief       => 'raised',
    -width        => 10,
    -padx         => '2m',
    -pady         => '1m'
  );

$timerBtn = $mw->Button( 
        -text       => 'Start', 
        -command    => sub {
            if ($stopped){
                $stopped = 0;
                $startMoment = time();
                $timerBtn->configure(-text => 'Stop');
                tick();
            } else {
                $timerBtn->configure(-text => 'Start');
                $timer->cancel();
            }
        }
    );

$resetBtn = $mw->Button(
        -text       => 'Reset',
        -command    => sub{
            $startMoment = time();
            $counterText = '0.00';
        }
    );

$counter->pack(-side => 'bottom', -fill => 'both');
$timerBtn->pack(-side => 'left', -fill => 'both', -expand => 'yes');
$resetBtn->pack(-side => 'right', -fill => 'both', -expand => 'yes');

sub tick{
    unless ($stopped){
        $timer = $mw->repeat(50, sub{ counter(); });
    }
}

sub counter{
    $elapsedMS = (time() - $startMoment);
    $counterText = sprintf("%.2f",$elapsedMS);    
}

$mw->bind('<Control-c>', sub{ $mw->destroy() });
$mw->bind('<Control-q>', sub{ $mw->destroy() });
$mw->MainLoop();

    [download]
[reply]
[d/l]
Re: A timer in Tcl/Tk in Perl::Tk
by Anonymous Monk on Feb 10, 2012 at 08:35 UTC

    Can't be done, there is no such thing as Perl::Tk

    Also, there is an example in the demo and test suite

[reply]
      Can you possibly post this example? I can't seem to find it...
[reply]
[reply]

        Or the local approach, the manual win32 local approach 

        $ perldoc -l Tk
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk.pod

$ grep -ril timer C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk/after.pod
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk/demos/zinc_lib/cou
+nter.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk/demos/zinc_lib/sim
+pleradar.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk/demos/zinc_lib/Zet
+ris.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk/Event.pm
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk/Panedwindow.pm
...

$ perldoc Tk::after
...

$ grep -ril after C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\
+demos
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/a
+rrows.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/B
+all.pm
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/b
+ounce.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/c
+text.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/e
+ntry3.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/i
+tems.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/m
+ega.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/p
+hoto1.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/s
+earch.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/t
+ranstile.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/widget_lib/v
+irtevents1.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/zinc_contrib
+_lib/TripleRotatingWheel.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/zinc_lib/cou
+nter.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/zinc_lib/gro
+ups_in_ATC_strips.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/zinc_lib/sim
+pleradar.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/zinc_lib/tes
+tGraphics.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/zinc_lib/whe
+elOfFortune.pl
C:\perl\site\5.14.1\lib\MSWin32-x86-multi-thread\Tk\demos/zinc_lib/Zet
+ris.pl

        [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom