#!/usr/bin/perl
# 
#  Copyright 2000 Philip Yuson 
#  Distributed as per the Perl copyright agreement. 
# 
# This script was written to illustrate Perl/Tk statements. 
# it was written with Windows in mind as if this were written for 
# Linux or Unix, I would have used the 'cal' command and the routines 
# would be a lot simpler. 
# 
# 
use strict;
use Tk;             # of course you need this 
use Date::Calc;     # you need this to calculate your date 


# Parms entered are year and month 
my ($year, $month) = @ARGV;

# set the maximum number of days for each month 
my @maxdays = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

#if leap year, change the max days for Feb 
$maxdays[2] = 29 if ($year % 4 == 0);

#if leap century, change the max days for Feb 
$maxdays[2] = 29 if ($year %400 == 0);


# Set $a to get the day of the week 
my $a = Date::Calc::Date_to_Text($year, $month, 01);
my @dateText = split(" ", $a);                     # split on spaces 
my @Literal = split("-", $dateText[1]);            # split on '-' 
$_ = $dateText[0];                              # set to day of week 
my @dayArray = ('Su', 'Mo', 'Tu', 'We', 'Th', 'Fr', 'Sa');  # Set the 
+day array 

#set the day hash 
my %days = ("Sun"=>0, "Mon"=>1, "Tue"=>2, "Wed"=>3, "Thu"=>4, "Fri"=>5
+, "Sat"=>6);
my $day = $days{$_};                          # get the day number 
my $on;

my $ndx = 0;                                  # initialize day number 
my $m = new MainWindow;                    # start a new window 
$m->configure(-title=>"$Literal[1] $Literal[2]");  # set the window ti
+tle 
for (my $row = 0; $row < 7; $row++) {         # create calendar rows 
    for (my $col = 0; $col < 7; $col++) {     # create calendar column
+s 
        $b = $m->Button(-width=>2,         # Create Button 
                 -activeforeground=>'white', # format the foreground 
                 -activebackground=>'blue'); # also the background 
        $b->grid(-row=>$row, -column=>$col);  # put this in the right 
+place 
        if ($row eq 0) {                   # if first row, 
           $b->configure(-text=>$dayArray[$col], # disable the button 
                                        -state=>'disabled');
        } else {
           if ($col eq $day && $row eq 1) { $on = 1; $ndx = 1 } # Turn
+ on switch if start of day 
           if (int($ndx) > int($maxdays[$month])) { $on = 0  }  # Turn
+ off switch if all days are displayed 
           if ($on) {
              $b->configure(-text=>$ndx++);  # put the day on the butt
+on 
                                             # and add one to the day 
              $b->bind("<ButtonPress>",      # If the button is presss
+ed 
                     [\&DateSelected, $year, $month]);  # execute the 
+Date Selected subroutine 
           } else {
              $b->configure(-state=>'disabled'); # if switch if off, d
+isable button 
           }
       }
       if ($col eq 0) {                   #if first column, this is Su
+nday 
          $b->configure(-fg=>'red',   # configure button 
                          -activeforeground=>'white',
                          -activebackground=>'red');
       }
    }
    if (int($ndx) > int($maxdays[$month])) { last  }  # if all days di
+splayed. exit 
}

MainLoop;  #Loop 

sub DateSelected {                        # execute when button is pre
+ssed 
    my ($w, $year, $month)  = @_;         # get the parms (widget, yea
+r and month) 
    my $text = $w->cget(-text);              # get the text on the but
+ton 
    print "Date Selected: $text\t$year\t$month\n";  # display informat
+ion 
}
[download]