#!/usr/bin/perl -w
#
# ktimer v0.03 --crb3 21aug02/01apr07
#
# simple kitchen countdown-timer app. be sure to change the
# WAVs to ones you have on your system. ditto the sound-player.
# as written, this is a one-shot timer; it doesn't have the
# state-logic to rerun anything.
#
# This program is copyright (C) 2002,2003 C. R. Bryan III
# (crb3@stormbringer.org), All Rights Reserved. It is released under
# the GNU General Public License v2. There is no warranty. Using
# this program to trigger high explosives is a Really Bad Idea,
# even if you need your five- and ten-minute warnings nonmaskable.
#
# v0.01: --crb3 21aug02
#       first version. it runs. the kids think it's annoying: that's
#       proof that it works.
# v0.02: --crb3 17may03
#       spruced it up for release.
# v0.03: --crb3 01Apr07
#       - added commandline options for scripted use
#       - debug: 'show' on $hrs was allowing only 00
#       - button label sorted out, is now what it will do.
#
use Tk;

#-------config area---------

#
# "pest" controls behavior at zero-hour. if pest==0, the noise is
# sounded _once_. if pest!=0, it keeps doing it, with "pestdelay"
# seconds wait between repeats.
#
$pest=1;                                # be a pest at timer-zero
$pestdelay=5;                           # seconds btwn pest repeats

$what="";                               # startup "what's being timed" string
$hrs="00";                              # preload hours value
$mns="10";                              # preload minutes value
$scs="05";                              # preload seconds value
$startgo=0;                             # start running immediately?
#
# the program slaps two halves of a commandline together in order
# to make a sound, so you've got a lot of flexibility here. if
# you don't happen to have a soundcard, you can use "beep" or "morbeep"
# to make rude noises on the PC speaker, with different command args
# for each sound. the listed WAVs are from kitchentimer.
#
$play="/usr/local/bin/wavplay -q";      # command-line to invoke soundmaker
$wav00="/usr/share/sounds/min00.wav";   # sound to play when time's up
$wav05="/usr/share/sounds/min05.wav";   # sound to play at 5-minute warning
$wav10="/usr/share/sounds/min10.wav";   # sound to play at 10-minute warning
$bgalt="red";                           # display turns this color at 0-hour
$bgwht="white";                         # display is this color when running
$bggry="lightgrey";                     # display is this color when editable
$butlblrun="run";                       # button legends. They don't need
$butlblstp="stop";                      # translating, do they? I mean, Perl
$butlbldun="done";                      # _is_ the Universal Language, right?

#---------------------------

$chatty=$debug=0;       # no real use here, but kept just in case
while(defined($ARGV[0]) and index($ARGV[0],'-')==0){
  $arg=shift(@ARGV);                    # get any the switches
  $key=substr($arg,1,1);                # get no-arg switches first
  substr($arg,0,2)="";
  if($key eq 'v'){                      # verbose?
    $chatty ^= 1;
    next;
  }elsif($key eq 'D'){                  # debug: enable any ad-hoc tracers
    $debug^=1;
    next;
  }elsif($key eq 'S'){                  # toggle: start immediately?
    $startgo^=1;
    next;
  }elsif($key eq '?'){                  # show helps and leave.
    print <<EOT;
 ktimer Perl/Tk kitchen-timer applet --crb3 21aug02/01apr07
     ktimer [options] [00:00:00]
   Options:
       -l 'the text'    'timing what' descriptive text legend
       -P '/p/app -q'   player tool plus switch-args for chimes
       -p n             switch/delay: pest-loop at timeout (Default: 5 secs)
       -x /p/f.n        ten-minute chime soundfile
       -y /p/f.n        five-minute chime soundfile
       -z /p/f.n        zero-minute chime soundfile
       -S               toggle: start running immediately
       -t 00:00:00      load timer with this (or tail-arg it)
       -?               show helps, then leave
EOT
#       -v               toggle: script gets chatty
#       -D               toggle: turn on ad-hoc debug tracers
    exit(0);
  }
  $arg =~ s/^\=//;                      # handles switch=arg
  $arg=shift(@ARGV) if($arg eq "" and ($ARGV[0] !~ /^\-\w/) );
#                     # handles space-separated switch/arg
  if($key eq 'l'){                      # text to display in 'what' field
    $what=$arg;
  }elsif($key eq 'P'){                  # player command to use
    $play=$arg;
  }elsif($key eq 'p'){                  # be-a-pest switch/delay
    $pestdelay=0+$arg;                  # coerce to numeric
    $pest=($pestdelay ? 1 : 0);         # i want it boolean
  }elsif($key eq 'x'){                  # ten-minute warning WAVfile
    $wav10=$arg;
  }elsif($key eq 'y'){                  # five-minute warning WAVfile
    $wav05=$arg;
  }elsif($key eq 'z'){                  # zero-minute warning WAVfile
    $wav00=$arg;
  }elsif($key eq 't'){
    ($hrs,$mns,$scs)=split(':',$arg);
    $scs='00' unless defined $scs;
  }else{
    warn "$0: unrecognized option -$key $arg\n";
  }
}
if(defined($ARGV[0])){
  ($hrs,$mns,$scs)=split(':',$ARGV[0]);
  $scs='00' unless defined $scs;
}

$bgrun=$bgwht;
$bgstop=$bggry;
$toggle=0;                              # misnamed. this is the pest-counter.
$running=0;                             # state boolean

#
# put references up top, for scope of visibility
#
$ref_button_1=$ref_entry_2=$ref_entry_3=$ref_entry_4=0;

my($top) = MainWindow->new();
$top->title("ktimer $what");
my($main_frame) = $top->Frame()->pack(
        -fill=>'both',
        -expand=>1
);


#
# chg_butstate.
# change the button's labeling to reflect what clicking it will do.
# this also starts and stops the countdown timer.
#
sub chg_butstate {
  if($running != 0){    # RUN -> STOP
    $ref_button_1->configure(-text => $butlblrun);
    $ref_entry_2->configure(-state => 'normal');
    $ref_entry_3->configure(-state => 'normal');
    $ref_entry_4->configure(-state => 'normal');
    $ref_entry_2->configure(-background => $bgstop);
    $ref_entry_3->configure(-background => $bgstop);
    $ref_entry_4->configure(-background => $bgstop);
    $running =0;
  }else{                # STOP -> RUN
    $ref_button_1->configure(-text => $butlblstp);
    $ref_entry_2->configure(-state => 'disabled');
    $ref_entry_3->configure(-state => 'disabled');
    $ref_entry_4->configure(-state => 'disabled');
    $ref_entry_2->configure(-background => $bgrun);
    $ref_entry_3->configure(-background => $bgrun);
    $ref_entry_4->configure(-background => $bgrun);
    $v=0+$hrs; $hrs=sprintf("%2.02d",$v);
    $v=0+$mns; $mns=sprintf("%2.02d",$v);
    $v=0+$scs; $scs=sprintf("%2.02d",$v);
    $running =1;
  }
}

#
# timer.
# callbacked once a second. the value in the display actually
# is the countdown value.
#
sub timer {
  if($pest and $scs eq "00" and $mns eq "00" and $hrs eq "00"){
    $toggle++; $toggle %= $pestdelay;
    return if $toggle;
    system("$play $wav00 &");
    return;
  }
  return unless $running;

  if($scs eq "01" and $mns eq "00" and $hrs eq "00"){   # time's up!
    $scs="00";
    &chg_butstate;              # turn off run/stop switches
    $ref_button_1->configure(-text => $butlbldun);
    $ref_entry_2->configure(-background => $bgalt);
    $ref_entry_3->configure(-background => $bgalt);
    $ref_entry_4->configure(-background => $bgalt);
    system("$play $wav00 &");
    $ref_button_1->flash;       # flash the button
  }else{
    $v = 0+$scs;        #coerce to numeric
    if($v != 0){
      $v--;
      $scs=sprintf("%0.02d",$v);

      if($scs eq "00" and $hrs eq "00"){
        if($mns eq "10"){               # do 10-minute chime
          system("$play $wav10 &");
        }elsif($mns eq "05"){           # do 5-minute chime
          system("$play $wav05 &");
        }
      }
      return;
    }

    $scs="59";
    $v = 0+$mns;        #coerce to numeric
    if($v != 0){
      $v--;
      $mns=sprintf("%0.02d",$v);
      return;
    }
    $mns="59";
    $v=0+$hrs;
    if($v != 0){
      $v--;
      $mns=sprintf("%0.02d",$v);
    }
  }
}

#
# ktimer_ui.
# interface generated by SpecTix (Perl enabled) version 1.2 from ktimer.ui
# For use with Tk400.202, using the gridbag geometry manager
#
sub ktimer_ui {
        my($root) = @_;

        # widget creation

        my($button_1) = $root->Button (
                -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*',
                -text => $butlblrun,
                -width => 4,
                -command => \&chg_butstate,
        );
        my($entry_1) = $root->Entry (
                -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*',
                -textvariable => \$what,
                -background => $bgwht,
        );
        my($entry_2) = $root->Entry (
                -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*',
                -textvariable => \$hrs,
                -width => '2',
        );
        my($label_1) = $root->Label (
                -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*',
                -padx => '0',
                -text => ':',
        );
        my($entry_3) = $root->Entry (
                -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*',
                -textvariable => \$mns,
                -width => '2',
        );
        my($label_2) = $root->Label (
                -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*',
                -padx => '0',
                -text => ':',
        );
        my($entry_4) = $root->Entry (
                -font => '-*-helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*',
                -textvariable => \$scs,
                -width => '2',
        );

        # Geometry management

        $button_1->grid(
                -in => $root,
                -column => '1',
                -row => '1'
        );
        $entry_1->grid(
                -in => $root,
                -column => '2',
                -row => '1'
        );
        $entry_2->grid(
                -in => $root,
                -column => '3',
                -row => '1'
        );
        $label_1->grid(
                -in => $root,
                -column => '4',
                -row => '1'
        );
        $entry_3->grid(
                -in => $root,
                -column => '5',
                -row => '1'
        );
        $label_2->grid(
                -in => $root,
                -column => '6',
                -row => '1'
        );
        $entry_4->grid(
                -in => $root,
                -column => '7',
                -row => '1'
        );

        # Resize behavior management

        # container $root (rows)
        $root->gridRowconfigure(1, -weight  => 0, -minsize  => 30);

        # container $root (columns)
        $root->gridColumnconfigure(1, -weight => 0, -minsize => 30);
        $root->gridColumnconfigure(2, -weight => 0, -minsize => 30);
        $root->gridColumnconfigure(3, -weight => 0, -minsize => 2);
        $root->gridColumnconfigure(4, -weight => 0, -minsize => 2);
        $root->gridColumnconfigure(5, -weight => 0, -minsize => 30);
        $root->gridColumnconfigure(6, -weight => 0, -minsize => 12);
        $root->gridColumnconfigure(7, -weight => 0, -minsize => 30);

        # additional interface code

        $button_1->configure(-command => \&chg_butstate);
        $root->repeat(1000,\&timer);

        $root->bind('<Control-q>', sub{ exit; });

        # end additional interface code
#
# save off some outside-access hooks to the parts we need
#

    $ref_button_1=$button_1;
    $ref_entry_2=$entry_2;
    $ref_entry_3=$entry_3;
    $ref_entry_4=$entry_4;

}


ktimer_ui $main_frame;
&chg_butstate if $startgo;
Tk::MainLoop;

1;
 Grab a
gzipped
copy
here
 
Syntax highlighting using Syntax::Highlight::Engine::Kate