This example shows how Perl can be used to create a window with a grid of buttons to display a calendar. The program has been tested on Windows98 (you'll need ActivePerl and Prima installed), but should work equally well on Mac, BSD, Unix, and GNU/Linux
The example illustrates several useful concepts:
use Prima qw(Buttons); use Prima::Application name => 'Hello1'; #Calculate the size of the buttons my $btnHeight = 36; my $btnWidth = $btnHeight; my $top = $btnHeight * 7; my $width = $btnWidth * 7; my %Buttons = (); #Current month and year are stored as global variables my $Month = 9; my $Year = 2002;
The basis for our whole application is the window, which can be stored in any standard variable. Later, we'll use this to add controls to the window.
#Create the basic window
my $Window = Prima::Window-> create(
text => 'Hello, world!',
size => [$width + $btnWidth, $top + 80],
onClose => sub { $::application-> destroy },
borderStyle => bs::Single,
);
Right. We need lots of buttons. 36 of the buggers, in fact. How best to do it?
Firstly, Perl's great loops: Loop x and y from 0 to 6 with no effort at all!
Secondly, we need a variable to store each button in, so we can refer to it later. I've used an array, where the 'key' is just the row and column number, eg. 4~2 for the button in row 4, column 2.
To create the button, use Button = window->insert(button->(property list))
If you want to know what properties an object has, the easiest way may be to run VB (Prima:VB, not Visual Basic!) which lists the properties and events for each object.
Finally, to add an event-handler, it's just another property with a special name (onClick, etc) and a reference to a subroutine (\&MySub or sub{print "hello";})
$Window->lock;
#Create an array of 6 x 6 buttons in a grid
foreach $y (0..6)
{
foreach $x (0..6)
{
#Give each a unique name, related to its row/column
$Buttons{"Date$x~$y"} = $Window-> insert(
qq(Prima::Button) =>
origin => [ (($x + 0.5) * $btnWidth), $top - (($y) * 36)],
size => [ 36, 36],
name => "Date$x~$y",
text => "$x, $y",
);
}
}
(exact appearance may vary between different operating systems and desktop themes)
Rather than introduce a label as-well, let's concentrate just on buttons, and use one as the title saying 'April 2004' or whatever. It's a very large, wide button, and a reference to it is kept in the $btnMonthName global variable so we can update its caption easily.
#Insert a large button to display the month name my $btnMonthName = $Window-> insert( qq(Prima::Button) => origin => [ $btnWidth * 1.5, $top + $btnHeight ], size => [ $btnWidth * 5, $btnHeight], name => "MonthName", text => "September 2002", );
This button calls our PrevMonth() function when it's clicked: see later in the program for a description of what the button does.
#Insert a button to go back a month. When clicked, it runs PrevMonth()
my $btnBack = $Window-> insert(
qq(Prima::Button) =>
origin => [ $btnWidth * 0.5 , $top + ($btnHeight * 1.25) ],
size => [ $btnWidth , $btnHeight / 2],
name => "Back",
text => "<",
onClick => sub{PrevMonth();},
);
Add a new button, which calls the NextMonth() function when you click on it. This is an easy way to interface more powerful perl-scripts to windows users who fear the command line!
#Insert a button to go forward a month. When clicked, it runs NextMonth()
my $btnNext = $Window-> insert(
qq(Prima::Button) =>
origin => [ $btnWidth * 6.5 , $top + ($btnHeight * 1.25) ],
size => [ $btnWidth , $btnHeight / 2],
name => "Next",
text => ">",
onClick => sub{NextMonth();},
);
#My function to draw days on the calendar
ReDraw();
$Window->unlock;
Once the window has been created, we can just set Prima running, and it will handle all the events happening to the form. The 'program' won't continue past this point until the window destroys itself (by someone clicking on the close button)
#This is the 'main loop', which runs indefinitely, responding to events, # until the program is shut-down run Prima;
This function updates the text on each button to display either a day-name, or a number representing the day of the month.
Since we stored all the button objects in an associative-array, we can refer to that to get each button object. Then simply ->Set the text property to whatever you like.
#
# Redraw the days/titles etc on each button
#
sub ReDraw()
{
#Display "Sun, Mon..." on the first row of buttons
my $y = 0;
foreach $x (0..6)
{
$Buttons{"Date$x~$y"}-> set(text=>('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$x]);
}
#Find out on which weekday the first of the month falls
my $Offset = DayOfWeek($Year, $Month, 1) -1;
my $Label;
#Loop through all the day-buttons
foreach $y(1..6)
{
foreach $x(0..6)
{
#What day of the month does this button represent (-6 to thirty-something)
my $Position = (($y - 1) * 7) + $x;
my $DayOfMonth = $Position - $Offset;
#If the button isn't in this month (start of first row, end of last row)
# then make the button blank
if(($DayOfMonth < 1) || ($DayOfMonth > DaysInMonth($Month, $Year)))
{
$Label = ' ';
}
else # otherwise display the day of the month
{
$Label = $DayOfMonth;
}
$Buttons{"Date$x~$y"}-> set(text=>$Label);
}
}
#Set the title to display the current month's name
$MonthName = ('January','February','March','April','May','June','July','August','September','October','November','December')[$Month - 1];
$btnMonthName->set( text=> "$MonthName $Year");
}
Two functions to change the date and redraw the screen. The month/year is stored in a global variable, with month=0 to 11, so we only need increment and decrement those.
#Move forward a month, and redraw the screen
sub NextMonth()
{
$Month++;
if( $Month > 11)
{
$Month = 0;
$Year++;
}
ReDraw();
}
#Move back a month, and redraw the screen
sub PrevMonth()
{
$Month--;
if( $Month < 0)
{
$Month = 11;
$Year--;
}
ReDraw();
}
As the note says, this was adapted from Mark Dettinger's page, so have a look there for the explanation.
#
# http://www.informatik.uni-ulm.de/pm/mitarbeiter/mark/day_of_week.html
#
# DayOfWeek(Y,M,D) = x
# x is from 0 to 6, where 0 is sunday and 6 is saturday
#
sub DayOfWeek()
{
my $Year = shift();
my $Month = shift();
my $Day = shift();
my $Century = int( $Year / 100) + 1;
$Year = $Year % 100;
my $C2 = (8 - 2*($Century % 4 ) ) % 8;
my $Y2 = $Year + int( $Year / 4 );
$Y2 %= 7; #optional
my @MonthTable = (1,4,4, 0,2,5, 0,3,6, 1,4,6 );
my $M2 = $MonthTable[$Month - 1];
if(IsLeapYear($Year) && ( $Month < 3))
{
$M2--;
}
my $D2 = $Day;
my $x = ($C2 + $Y2 + $M2 + $D2 - 1 ) % 7;
}
This code is a bit of a cheat: September 1752 may only have had 18 days, but the last day of the month was 1752-September-30, so beware! It works fine for all else though.
#
#DaysInMonth (Month(1-12), $Year(any)) = x (28 - 31)
#
sub DaysInMonth()
{
my $Month = shift();
my $Year = shift();
#Only one special case to cater for
if(($Year == 1752) && ($Month == 9))
{
return(18);
}
my @MonthDays = (31,28,31,30,31,30,31,31,30,30,31);
#Leap-year februaries
if($Month == 2)
{
return(28 + IsLeapYear($Year));
}
else # normal months
{
return($MonthDays[$Month - 1]);
}
}
This is a fairly standard formula, which just looks for leap-years. It would be more efficient if we checked the not-divisible-by-4 years first, but it's easier to understand this way around!
#
# Find leap years. (returns 1=leap or 0=normal)
#
# Works on julian/gregorian, with english-changeover.
# Doesn't work before julian (i.e. before about AD100)
sub IsLeapYear()
{
my $Year = shift();
#Every 400 years in gregorian is leap, but in julian it isn't.
if(($Year % 400) == 0)
{
if ($Year < 1752)
{
return(0);
}
else
{
return(1);
}
}
else
{
#Other centuries are not leap
if(($Year % 100) == 0)
{
return(0);
}
else
{
#Normal system: every 4th year is leap
if(($Year % 4) == 0)
{
return(1);
}
else
{
return(0);
}
}
}
}
With the application saved as a perl script, you simply need to type:
perl calendar.pl
(I'll put a download copy here soon, but you can copy the code above and remove the commenty-bits)
If it says 'perl not found' then install perl, and make sure that perl.exe is in your path. Type 'path' to check it, or edit autoexec.bat to include the line 'path=c:\perl\bin;$PATH' at the end
If it comes up with lots of Prima errors, then Prima was probably not installed perfectly. It can be a bitch to install, so good luck with it!
If it says 'Prima not found' or equivalent, then you need to install Prima, and run it's installation script. ('perl install_win32.pl' or equivalent)
I don't think you can compile Prima programs using Perl2Exe, but you're welcome to correct me
That's the end of the article: I'll probably put a few more notes here later, but I don't know any good Prima tutorials I can direct you to for more information. Please do email me if you find any good sites, or if you have tutorials and example programs yourself on the web.
In this article, I showed how to create a window in Windows using Perl, then how to add buttons to the window, how to change the text of buttons, and how to make buttons call a function when they're pressed. I hope it was helpful; please link to it and reccommend it! Thanks for reading.