Re: Perl / Tk Calendar - advice please.

[zentara]

Here's a few links and script I had in my tk-calendar collection.:-)

Line up Calendar

Tk::MiniCalendar

#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::ChooseDate;

#sets date thru the textvariable
my $date = '2006/6/6';

my $mw = new MainWindow;
$mw->geometry('200x50');

$mw->fontCreate('big',
   -family=>'courier',
     -weight=>'bold',
       -size=>int(-18*18/14));

my $cd = $mw->ChooseDate(
      -language =>'Italian',
      -font =>'big',         # the label font
      -bg=>'lightsteelblue',  #the label bg
      -textvariable=>\$date,
      -arrowcolor => 'black',
      -arrowactivecolor=>'yellow',
      -datecolor=> 'blue',
      -dateformat => 1,
      -orthodox => 0, 
      -daysofweekcolor=>'lightgreen',
      -highlightcolor=> 'pink', 
      -linecolor=> 'green',
      -yearcolor=> 'black',
      -command=>sub{print "$date\n"},
)->pack(-fill=>'x', -expand=>1);

my $cdcan = $cd->Subwidget('canvas');
$cdcan->configure(-bg=>'black');  # bg of weekdays bar 

my $cdtop = $cd->Subwidget('toplevel');
$cdtop->configure(-bg=>'black');  # outline of popup 

# sets the date thru set
$cd->set( y=>2005, m=>5, d=>5 );

MainLoop;

#!/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;

$year ||= '2006';
$month ||= '07';

# 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 win
+dow title
for ( my $row = 0 ; $row < 7 ; $row++ ) {                # create cale
+ndar rows
    for ( my $col = 0 ; $col < 7 ; $col++ ) {    # create calendar col
+umns
        $b = $m->Button(
            -width            => 2,              # Create Button
            -activeforeground => 'white',        # format the foregrou
+nd
            -activebackground => 'blue'
        );                                       # also the background
        $b->grid( -row => $row, -column => $col ); # put this in the r
+ight place
        if ( $row eq 0 ) {                         # if first row,
            $b->configure(
                -text  => $dayArray[$col],         # disable the butto
+n
                -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 button

                # and add one to the day
                $b->bind(
                    "<ButtonPress>",                 # If the button i
+s presssed
                    [ \&DateSelected, $year, $month ]
                );    # execute the Date Selected subroutine
            }
            else {
                $b->configure( -state => 'disabled' )
                  ;    # if switch if off, disable button
            }
        }
        if ( $col eq 0 ) {    #if first column, this is Sunday
            $b->configure(
                -fg               => 'red',     # configure button
                -activeforeground => 'white',
                -activebackground => 'red'
            );
        }
    }
    if ( int($ndx) > int( $maxdays[$month] ) ) {
        last;
    }    # if all days displayed. exit
}

MainLoop;    #Loop

sub DateSelected {    # execute when button is pressed
    my ( $w, $year, $month ) = @_;    # get the parms (widget, year an
+d month)
    my $text = $w->cget( -text );                   # get the text on 
+the button
    print "Date Selected: $text\t$year\t$month\n";  # display informat
+ion
}

[ff]

Thanks for the examples. Something I'm missing in the ChooseDate example is how you are supposed to access the selected value. I can see that as values are selected they are printed on the console screen. But how do you use

$cd->get();

to return an answer? That is, if the code sample had been part of a subroutine, how would the calling portion receive the $cd->get(); output from using ChooseDate?

[zentara]

There are a couple of obvious ways. First the date is stored in a textvariable, so all you have to do is read $date. Second, if you read "perldoc Tk::ChooseDate", there is the get method. Example->
Read more... (2 kB)

[ff]

Hmm, I guess $date stands out a little better with additional sleep and a whack on the side of the head. :-)

Perhaps my problem was that I was reading the docs and only perceived the get method for fishing data out, and didn't think about invoking get via a separate button that could access the object via a parameter. But then that's why, at midnight, I asked. :-)

That same fascination with $cd->get and my fear of MainLoop blinded me to the fact that $date was available to pass as a return value after the MainLoop finished. I was puzzling with If "get" is how you get the date, how does "get" continue to work after the MainLoop?

So, thanks to your example, the following obeys use strict and gets the value from the calendar by wrapping the appropriate code in a subroutine. Thanks!

(Interestingly in this example, the $date supplied to the ff_get sub remains frozen at 05/05/2005 since it doesn't update dynamically as global. But the value that the user clicks on the calendar, as obtained via $cd_or->get, does since the lookup method gets to fire later, i.e. when the 'Get' button is pushed.)

Read more... (2 kB)