#!/pro/bin/perl
use strict;
use warnings;
use Tk;
use Tk::Clock;
my @bw = reverse qw( Black White );
my $m = MainWindow->new;
$m->configure (
-foreground => $bw[0],
-background => $bw[1],
);
my $face = $^O =~ m/mswin/i ? "Arial" : "DejaVu Sans Mono";
my $c = $m->Clock (
-background => $bw[1],
-relief => "flat",
)->pack (
-expand => 1,
-fill => "both",
-padx => 30,
-pady => 30,
-side => "left",
);
$c->config (
useDigital => 0,
useInfo => 1,
useAnalog => 1,
secsColor => "Red",
handColor => $bw[0],
tickColor => $bw[0],
tickFreq => 1,
tickDiff => 1,
handCenter => 1,
anaScale => 800,
autoScale => 1,
infoFormat => "",
infoFont => "{$face} 48",
infoColor => "Gray10",
);
my ($l, $rest, $end, $secs, $left) = ("");
sub rest
{
use integer;
my $now = time;
unless (defined $end) {
$rest = "";
$secs = "";
$left = "";
$end = undef;
return;
}
$now > $end and return;
$secs = $end - $now;
$rest = int (($secs + 10) / 60);
$l->configure (
-background => "Black",
-foreground =>
$rest > 5 ? "Green4" :
$rest > 3 ? "Yellow" :
$secs > 60 ? "Orange" : "Red");
$left = sprintf "%02d:%02d", $secs / 60, $secs % 60;
$c->config (infoFormat => $left);
$secs == 60 and $l->bell for 1..2;
$secs < 60 and $rest = $secs;
if ($rest) {
$l->after (100, \&rest);
return;
}
$l->bell for 1..10;
$l->configure (-background => "Red");
$l->after (30000, sub { $l->configure (-background => "Black") });
$c->config (infoFormat => "");
$rest = "";
$end = undef;
} # rest
sub start
{
my $val = 60 * shift;
$end = time + $val;
rest ();
} # start
my $f = $m->Frame (-background => "Black")->pack (
-expand => 1,
-padx => 30,
-pady => 30,
-fill => "both",
-side => "left",
);
$l = $f->Label (
-textvariable => \$rest,
-font => "{$face} 200 bold",
-background => "Black",
)->pack (-expand => 1, -side => "top", -fill => "both", -anchor => "c");
my $g = $f->Frame (-background => "Black")->pack (
-side => "bottom", -anchor => "se", -fill => "x");
my $ctrl = $g->Frame (-background => "Black")->pack (
-side => "bottom", -anchor => "se", -fill => "x");
my $smll = $g->Frame (-background => "Black")->pack (
-side => "top", -anchor => "s", -fill => "x");
$smll->Label (
-textvariable => \$secs,
-background => "Black",
-foreground => "Yellow",
-anchor => "sw",
)->pack (-side => "left", -anchor => "w");
$smll->Label (
-textvariable => \$left,
-background => "Black",
-foreground => "Yellow",
-anchor => "se",
)->pack (-side => "right", -anchor => "e");
my %bo = (
-borderwidth => 1,
-highlightthickness => 1,
-relief => "flat",
-activebackground => "Gray10",
-activeforeground => "Red2",
-highlightcolor => "Red2",
-background => "Black",
-foreground => "Red2",
);
for (1 .. 6) {
my $d = 5 * $_;
$ctrl->Button (%bo,
-text => $d,
-font => "fixed",
-command => sub { start ($d) },
)->grid (-row => 0, -column => $_ - 1, -sticky => "news");
}
$ctrl->Button (%bo,
-text => " 0",
-font => "fixed",
-command => sub { $end = undef; rest (); },
)->grid (-row => 1, -column => 0, -sticky => "news");
$ctrl->Button (%bo,
-text => "-1",
-font => "fixed",
-command => sub { defined $end and $end -= 60; },
)->grid (-row => 1, -column => 1, -sticky => "news");
$ctrl->Button (%bo,
-text => "-\x{00bd}",
-font => "fixed",
-command => sub { defined $end and $end -= 30; },
)->grid (-row => 1, -column => 2, -sticky => "news");
$ctrl->Button (%bo,
-text => "+\x{00bd}",
-font => "fixed",
-command => sub { defined $end and $end += 30; },
)->grid (-row => 1, -column => 3, -sticky => "news");
$ctrl->Button (%bo,
-text => "+1",
-font => "fixed",
-command => sub { defined $end and $end += 60; },
)->grid (-row => 1, -column => 4, -sticky => "news");
$ctrl->Button (%bo,
-text => "XX",
-font => "fixed",
-command => sub { exit; },
)->grid (-row => 1, -column => 5, -sticky => "news");
$ctrl->gridColumnconfigure ($_, -weight => 1) for 0..5;
MainLoop;