Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Countdown timer using Tk

by GrandFather (Saint)
on Nov 20, 2005 at 03:28 UTC ( [id://510183]=CUFP: print w/replies, xml ) Need Help??

This timer was written in the first instance for timing social Badminton games, but is easily adapted for other similar purposes.

Key features are: options persistence using XML::Simple and resizing the font for displaying the remaining time to accommodate resizing the display window.

Note that the Win32::Sound related chunks of code will need to be removed or altered for non-Windows systems.

use warnings; use strict; use Tk; use Tk::Font; use Tk::DialogBox; use Time::HiRes qw(gettimeofday tv_interval); use Win32::Sound; use XML::Simple; my $options = XMLin ('teams.badDB') if -e 'teams.badDB'; $options->{'time'} = 15 * 60 if ! exists $options->{'time'}; $options->{'width'} = 200 if ! exists $options->{'width'}; $options->{'height'} = 80 if ! exists $options->{'height'}; $options->{'alarm'} = 'WARBLEHI.WAV' if ! exists $options->{'alarm'}; $options->{'touched'} = 1; my $main = MainWindow->new (-title => "Badminton Timer"); my $clockFace = $main->Canvas (-width => $options->{'width'}, -height => $options->{'height'}); my $menubar = $main->Menu (); $main->configure(-menu => $menubar); $main->bind ('<Configure>' => [\&ResizeTime, Ev('w'), Ev('h')]); my $fileMenu = $menubar->cascade (-label => "File", -underline => 0, -tearoff => 0); $fileMenu->command(-label => '~Options', -command => \&SetOptions); $fileMenu->command(-label => '~Exit', -command => sub {$main->destroy +()}); $clockFace->configure(-background => 'white'); my ($width, $height) = ($clockFace->cget (-width), $clockFace->cget (- +height)); my $timeField = $clockFace->createText ($width / 2, $height / 2, -just +ify => 'center'); my $font = $main->fontCreate ('Courier', -size => -10); # Clock control buttons my $stop = $main->Button (-text => "Stop", -command => \&StopTimer); my $start = $main->Button (-text => "Start", -command => \&StartTimer) +; my $reset = $main->Button (-text => "Reset", -command => \&ResetTimer) +; my @commonOps = (-bottom => '%100', -top => 'none', -pady => 5, -padx +=> 5); $stop->form (-right => $start, @commonOps); $start->form (-right => $reset, @commonOps); $reset->form (-right => '%100', @commonOps); $clockFace->form (-left => '%0', -right => '%100', -top => '%0', -bottom => $start) +; ResetTimer (); Refresh (); MainLoop; open outFile, '>', 'teams.badDB'; print outFile XMLout ($options); close outFile; # subs and sub globals my $LastTick; my $timer; my $remaining; my $alarmCount = 0; sub ResetTimer { doStopTimer (); doResetTimer (); $alarmCount = 0; } sub doResetTimer { $remaining = int $options->{'time'}; ShowTime (); } sub StartTimer { doResetTimer () if ! defined $remaining or $remaining <= 0; $LastTick = [gettimeofday ()]; $timer = $clockFace->repeat (100, [\&UpdateTime, 0]); $clockFace->configure(-background => 'white'); $alarmCount = 0; } sub StopTimer { doStopTimer (); doResetTimer () if ! defined $remaining or $remaining <= 0; $alarmCount = -1; } sub doStopTimer { $timer->cancel () if defined $timer; $clockFace->configure(-background => 'gray'); } sub UpdateTime { return if ! defined $timer or ! defined $remaining; my $now = [gettimeofday ()]; my $delta = tv_interval ($LastTick, $now); $remaining -= $delta; $LastTick = $now; if ($remaining > 0) { ShowTime (); } elsif ($remaining > -60) { my $currBK = $clockFace->cget('-background'); my $colour = $currBK eq 'red' ? 'white' : 'red'; $clockFace->configure(-background => $colour); $timer->time (300) if $timer->time () == 100; return if $alarmCount < 0; my $nextAlarm = -$remaining / 5; return if $alarmCount > $nextAlarm; my $alarmVolume = 15 + 20 * $nextAlarm; $alarmVolume = 100 if $alarmVolume > 100; Win32::Sound::Volume ("$alarmVolume%", "$alarmVolume%"); Win32::Sound::Play ($options->{'alarm'}, SND_ASYNC); ++$alarmCount; } else { StopTimer (); $clockFace->configure(-background => 'red'); } } sub ShowTime { $clockFace->itemconfigure ($timeField, -text => AsMMSS ($remaining)); Refresh () if $options->{'touched'}; } sub AsMMSS {# convert to MM:SS format my $time = shift; my $secs = $time % 60; my $mins = int($time / 60); return sprintf "%02d:%02d", $mins, $secs; } sub Refresh { my $width = $options->{'width'} ; my $height = $options->{'height'}; my $widthF = $font->measure ("00:00"); my $heightF = $font->metrics(-linespace); my $xRatio = $width / $widthF; my $yRatio = $height / $heightF; my $minRatio = $xRatio < $yRatio ? $xRatio : $yRatio; $minRatio = (int ($minRatio * 100 + 0.5)) / 100; my $fontSize = $font->actual (-size); my $newSize = $minRatio * ($fontSize < 0 ? $fontSize++ : $fontSize--); $font->configure (-size => $newSize); $clockFace->itemconfigure($timeField, -font => $font); $clockFace->coords ($timeField, $width / 2, $height / 2); $options->{'touched'} = 0; } sub SetOptions { my $dlg = $main->DialogBox (-title => "Set timeout", -buttons => ["OK" +, "Cancel"]); my $timeText = $dlg->add ('Text', -height => 1, -width => 10); my $timeLabel = $dlg->add ('Label', -text => 'Minutes: ', -anchor => ' +w'); my $soundText = $dlg->add ('Text', -height => 1, -width => 40); my $soundLabel = $dlg->add ('Label', -text => 'Alarm Sound: ', -anchor + => 'w'); $timeText->Contents (AsMMSS ($options->{'time'})); $soundText->Contents ($options->{'alarm'}); $timeLabel->form (-left => '%0', -right => $timeText, -top => '%0'); $timeText->form (-right => '%100', -top => '%0'); $soundLabel->form (-left => '%0', -right => $soundText, -top => $timeT +ext); $soundText->form (-right => '%100', -top => $timeText); my $but = $dlg->Show (-global); return if $but ne 'OK'; $options->{'alarm'} = $soundText->Contents (); chomp $options->{'alarm'}; my ($mins, $secs) = $timeText->Contents () =~ /(\d+(?:\.\d*)?)(?::(\d+ +))?/; $mins += $secs / 60.0 if defined $secs; $options->{'time'} = $mins * 60; StopTimer (); ResetTimer (); } sub ResizeTime { my ($widget, $width, $height) = @_; return if $widget != $clockFace; $options->{'height'} = $height; $options->{'width'} = $width; $options->{'touched'} = 1; }

DWIM is Perl's answer to Gödel

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://510183]
Approved by ww
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2024-03-29 13:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found