#!/usr/bin/perl5 -w # # Activity timer application. Doubles up as a chess clock. # use strict; use Tk; use POSIX qw(mktime strftime); use Time::HiRes qw(gettimeofday tv_interval); use File::Spec::Functions qw(splitpath); # # Main scoped variables (yuck!) use to control state of activity timer # my $current; # Index of current activity or undef my $curr_timer; # Current timer repeat widget my @activity; # AoH - holds info about the activities: # # $activity[$i]{frame} Frame widget # {legend} Button legend # {timstr} Time as string # {button} Button widget # {timlab} Time label widget # {start} Array of start times in # Time::HiRes form # {end} Array of finish times in # Time::HiRes form # {elapsed} Floating seconds from # previous run # Configure main menu bar my $main = MainWindow->new; $main->configure(-menu => my $menubar = $main->Menu); my $file = $menubar->cascade(-label => "File", -underline => 0, -tearoff => 0); $file->command(-label => '~Open', -command => [\&file_dialog, 'open']) +; $file->command(-label => '~Save', -command => [\&save]); $file->command(-label => 'Save ~As', -command => [\&file_dialog, 'save +']); my $ori = $file->cascade(-label => 'O~rientation', -tearoff => 0); $file->command(-label => '~Exit', -command => [\&save, 'exit']); $file->command(-label => '~Quit', -command => [\&exit]); $menubar->cascade(qw/-label Button -underline 0 -tearoff 0 -menuitems/ + => [ [command => '~New', -command => [\&activity_configure]], [command => 'Ne~xt', -command => [sub {&activate($current+1)} +]], [command => '~Stop', -command => [\&deactivate]], ]); # More main scoped variables, This time for frame orientation: my $orient = 0; # 0=vertical, 1=horizontal my $toplevel_dirn = 'top'; my $frame_dirn = 'left'; $ori->radiobutton(-label => '~Vertical', -variable => \$orient, -value => 0, -command => [\&render_orientation]); $ori->radiobutton(-label => '~Horizontal', -variable => \$orient, -value => 1, -command => [\&render_orientation]); # Now for the main loop MainLoop; # --- End of main program my $filnam; # Current save file - again main program scoped sub save { (unshift @_,'save'),goto &file_dialog if !defined $filnam; OPEN_TRY: { if (!open SAVE,">$filnam") { # Handle what to do when you cannot save my $whattodo = $main->Dialog( -title => "Error during save", -text => "what to do now?", -buttons => qw(Abort Retry Cancel)); my $resp = $whattodo->Show; exit if $resp eq 'Abort'; redo OPEN_TRY if $resp eq 'Retry'; return; } } # File was opened successfully. Save details in .ini format print SAVE <<END; [Global] Orientation=$orient END for (0..$#activity) { my ($legend,$time,$start,$end,$elapsed) = @{%{$activity[$_]}}{qw(legend timstr start end elapsed)}; # Add up times of current activity my $tsecs = 0; for my $i (0..$#$end) { $tsecs += tv_interval($start->[$i],$end->[$i]); } $tsecs += $elapsed if $elapsed; $tsecs += tv_interval($start->[-1],[gettimeofday]) if defined( +$current) && ($_ == $current); print SAVE <<END2; [Button $legend] time=$time elapsed=$tsecs END2 } close SAVE; exit if @_ && ('exit' eq shift); } # teardown_activities - remove all Tk widgets associated with activiti +es sub teardown_activities { $activity[$current]{timlab}->afterCancel($curr_timer) if $curr_tim +er; $_->{frame} && $_->{frame}->destroy for @activity; undef $curr_timer; } # file_dialog used for open and save-as, and first time save. sub file_dialog { my $op = ucfirst shift; my $dialog_method = "get${op}File"; my @types = ( [".ini files", '.ini'], ["all files", '*'], ); $filnam = $main->$dialog_method( -filetypes => \@types); return if !$filnam; # We've got a file name, make sure it as extension, default .ini my ($vol,$dir,$fil) = splitpath($filnam); $filnam .= '.ini' if $fil !~ /\./; goto &save if $op eq 'Save'; # not Save, so must be Open. open INI,$filnam or return undef; teardown_activities; @activity = (); my $i = -1; # Load activities from ini file while (<INI>) { if (/^\[button\s+(\w+)\]/i) { $activity[++$i] = {legend=>$1}; next; } next if !(my ($attr,$val) = /^(\w+)=(.*)/); $orient = $val if lc($attr) eq 'orientation'; if (lc($attr) eq 'time') { $activity[$i]{timstr} = $val; } if (lc($attr) eq 'elapsed') { $activity[$i]{elapsed} = $val; } } close INI; undef $current; # Draw everything on screen &render_orientation; } # render_orientation - used to flip between horizontal and vertical # also used to render activities from file sub render_orientation { $toplevel_dirn = qw(top left)[$orient]; $frame_dirn = qw(left top)[$orient]; teardown_activities; # Loop for each activity for my $i (0..$#activity) { # Frame my $newfrm = $main->Frame; $activity[$i]{frame} = $newfrm; $newfrm->pack(-side => $toplevel_dirn); # Button my $newbut = $newfrm->Button( -text => $activity[$i]{legend}, -command => [\&activate, $i]); $newbut->pack(-side => $frame_dirn); # Bind right mouseclick $newbut->bind('<3>',sub {&activity_configure($i)}); $activity[$i]{button} = $newbut; # Time display as label my $newtim = $newfrm->Label(-text => $activity[$i]{timstr}); $newtim->pack(-side => $frame_dirn); $activity[$i]{timlab} = $newtim; # Render current activity in white, and enable timer if (defined $current and $i == $current) { $newtim->configure(-background => 'white'); $curr_timer = $newtim->repeat(1000,[\&time_add,$i]); } } } # Add a new activity (callback from mainmenu=>button=>new) sub add_entry { my $legend = shift; $legend = $legend->get if ref $legend; #Get legend if in a call +back # New Frame my $this = $main->Frame; $this->pack(-side=>$toplevel_dirn); my $i= @activity; # New Button my $button = $this->Button(-text => $legend, -command => [\&activate, $i], ); $button->pack(-side => $frame_dirn); $button->bind('<3>',sub {&activity_configure($i)}); my $cell_time = "00:00:00"; # New time display as label my $tim = $this->Label(-text => $cell_time); $tim->pack(-side => $frame_dirn); # New entry in activity array push @activity, { frame => $this, legend => $legend, timstr => $cell_time, timlab => $tim, button => $button, }; } # Configuration toplevel window for an activity. Called with ($idx) if + edit otherwise new sub activity_configure { my $idx = shift; my $legend = ''; $legend = $activity[$idx]{legend} if defined $idx; # Retrieve e +xisting legend # New window my $tl = $main->Toplevel(-title => ($legend || "New")." Button"); # Button legend $tl->Label(-text => 'Button Legend')->pack; my $legentry = $tl->Entry(-text => \$legend); $legentry->pack; # Special stuff in count frame - not yet implemented my $count = $tl->Frame; $count->pack; $count->Label(-text => 'Alarm at')->pack(-side => 'left'); $count->Entry->pack(-side => 'left'); # Command buttons frame my $cmds = $tl->Frame; $cmds->pack; if (defined $idx) { # Existing activity - OK Apply Delete Cancel $cmds->Button(-text => 'OK', -command => sub {&edit_entry($idx +,$legentry);$tl->destroy;}) ->pack(-side => 'left'); $cmds->Button(-text => 'Apply', -command => [\&edit_entry, $id +x, $legentry]) ->pack(-side => 'left'); $cmds->Button(-text => 'Delete', -command => sub {&delete_entr +y($idx);$tl->destroy;}) ->pack(-side => 'left'); } else { # New activity - OK Apply Cancel $cmds->Button(-text => 'OK', -command => sub {&add_entry($lege +ntry);$tl->destroy;}) ->pack(-side => 'left'); $cmds->Button(-text => 'Apply', -command => [\&add_entry, $leg +entry]) ->pack(-side => 'left'); } $cmds->Button(-text => 'Cancel', -command => [$tl => 'destroy'])-> +pack(-side => 'left'); } # deactivate - turn off clock sub deactivate { $activity[$current]{timlab}->configure(-background => 'gray'); $activity[$current]{timlab}->afterCancel($curr_timer); push @{$activity[$current]{end}}, [gettimeofday]; undef $current; } # activate - start timing selected activity sub activate { my $idx = shift; return if defined $current and $current == $idx; $idx = 0 if $idx >= @activity; my $tim = $activity[$idx]{timlab}; deactivate if defined $current; $current = $idx; # calculcate existing time my $tsecs = 0; for my $i (0..$#{$activity[$idx]{end}}) { $tsecs += tv_interval($activity[$idx]{start}[$i],$activity[$id +x]{end}[$i]); } $tsecs += $activity[$idx]{elapsed} if exists $activity[$idx]{elaps +ed}; my $millisecs = ($tsecs - int $tsecs) * 1000; push @{$activity[$idx]{start}}, [gettimeofday]; $tim->configure(-background => 'white'); $tim->after($millisecs,[\&time_add,$idx]); # split seco +nd remaining $curr_timer = $tim->repeat(1000,[\&time_add,$idx]); # repeat ti +mer to update every second } # delete an activity sub delete_entry { my ($idx) = @_; deactivate if defined($current) && $idx == $current; $activity[$idx]{frame}->destroy; splice @activity,$idx,1; } # edit an activity sub edit_entry { my ($idx,$leg) = @_; $activity[$idx]{legend} = $leg->get; $activity[$idx]{button}->configure(-text => $activity[$idx]{legend +}); } # time_add called once a second to update time display sub time_add { my $idx = shift; # Calculate new time my $since = $activity[$idx]{start}[-1]; my $tsecs = tv_interval($since, [gettimeofday]); for my $i (0..$#{$activity[$idx]{end}}) { $tsecs += tv_interval($activity[$idx]{start}[$i],$activity[$id +x]{end}[$i]); } $tsecs += $activity[$idx]{elapsed} if exists $activity[$idx]{elaps +ed}; # convert to HH:MM:SS format and display my $secs = $tsecs % 60; my $mins = int($tsecs / 60); my $hours = int($mins / 60); $mins = $mins % 60; my $tim = strftime("%H:%M:%S",$secs,$mins,$hours,0,0,0,0,0); $activity[$idx]{timstr} = $tim; $activity[$idx]{timlab}->configure(-text => $tim); }

In reply to Activity timer / chess clock by rinceWind

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.