#!/usr/bin/perl -w # $Id: bday,v 1.3 2002/07/24 10:04:30 tom Exp $ # # Purpose: # To demonstrate the Perl5 Cdk Calendar Widget # Set some global variables. my %birthdays = (); my %appointments = (); my %anniversay = (); # Initialize Cdk. use Cdk; Cdk::init(); # Create the calendar object. my $calendar = new Cdk::Calendar ('Dattrib' => "", 'Mattrib' => "", 'Yattrib' => "", 'Highlight' => ""); # Create the scrolling window. my $swindow = new Cdk::Swindow ('Title' => "Date Information", 'Lines' => 300, 'Height' => 4, 'Width' => 50, 'Ypos' => "BOTTOM"); # Set the key binding for the calendar widget. $calendar->bind ('Key' => "m", 'Function' => sub { setMarkerCB ($calendar);}); # Set the post-process function for the calendar widget. $calendar->postProcess ('Function' => sub { checkDatePP ($calendar);}); # Draw the scrolling window. $swindow->draw(); # Let the user play. for (;;) { # Activate the object. my $ret = $calendar->activate(); } # Exit Cdk. Cdk::end(); # # This checks if the current date has a marker set on it. # sub checkDatePP { my $calendar = shift; } # # This allows the user to create a marker. # sub setMarkerCB { my $calendar = shift; my @mesg = ("What type of a marker is it?"); my @buttons = ("Birthday", "Anniversary", "Appointment"); # Get the current date the marker is at. my ($day, $month, $year) = $calendar->getDate(); # Ask the user what type of marker to add. my $dialog = new Cdk::Dialog ('Message' => \@mesg, 'Buttons' => \@buttons); my $choice = $dialog->activate(); undef $dialog; # If they hit escape, tell them... if (!defined $choice) { popupLabel (["Escape Hit. No marker set."]); $calendar->draw(); return 1; } # Check the choice. if ($choice == 0) { addBirthdayMarker ($day, $month, $year); } elsif ($choice == 1) { addAnniversaryMarker ($day, $month, $year); } elsif ($choice == 2) { addAppointmentMarker ($day, $month, $year); } return 1; } # # # sub addBirthdayMarker { my ($day, $month, $year) = @_; } # # # sub addAnniversaryMarker { my ($day, $month, $year) = @_; } # # # sub addAppointmentMarker { my ($day, $month, $year) = @_; }