Curses::Widgets::Calendar - Calendar Widgets
Index
Code Index:
NAME
Curses::Widgets::Calendar - Calendar Widgets
MODULE VERSION
$Id: Calendar.pm,v 1.103 2002/11/03 23:33:05 corliss Exp corliss $
SYNOPSIS
use Curses::Widgets::Calendar;
$cal = Curses::Widgets::Calendar->({
CAPTION => 'Appointments',
CAPTIONCOL => 'yellow',
INPUTFUNC => \&scankey,
FOREGROUND => undef,
BACKGROUND => 'black',
BORDER => 1,
BORDERCOL => 'red',
FOCUSSWITCH => "\t",
X => 1,
Y => 1,
HIGHLIGHT => [12, 17, 25],
HIGHLIGHTCOL=> 'green',
MONTH => '11/2001',
ONYEAR => \&yearly,
ONMONTH => \&monthly,
ONDAY => \&daily,
});
$cal->draw($mwh, 1);
See the Curses::Widgets pod for other methods.
REQUIREMENTS
DESCRIPTION
Curses::Widgets::Calendar provides simplified OO access to Curses-based
calendars. Each object maintains it's own state information.
METHODS
draw
$cal->draw($mwh, 1);
The draw method renders the calendar in its current state. This
requires a valid handle to a curses window in which it will render
itself. The optional second argument, if true, will cause the calendar's
selected day to be rendered in standout mode (inverse video).
HISTORY
- 1999/12/29 -- Original calendar widget in functional model
- 2001/07/05 -- First incarnation in OO architecture
AUTHOR/COPYRIGHT
(c) 2001 Arthur Corliss (corliss@digitalmages.com)
# Curses::Widgets::Calendar.pm -- Button Set Widgets
#
# (c) 2001, Arthur Corliss <corliss@digitalmages.com>
#
# $Id: Calendar.pm,v 1.103 2002/11/03 23:33:05 corliss Exp corliss $
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#####################################################################
#####################################################################
#
# Environment definitions
#
#####################################################################
package Curses::Widgets::Calendar;
use strict;
use vars qw($VERSION @ISA);
use Carp;
use Curses;
use Curses::Widgets;
($VERSION) = (q$Revision: 1.103 $ =~ /(\d+(?:\.(\d+))+)/);
@ISA = qw(Curses::Widgets);
#####################################################################
#
# Module code follows
#
#####################################################################
sub _conf {
# Validates and initialises the new TextField object.
#
# Usage: $self->_conf(%conf);
my $self = shift;
my %conf = (
INPUTFUNC => \&scankey,
BORDER => 1,
FOCUSSWITCH => "\t",
HIGHLIGHT => [],
VALUE => 1,
MONTH => join('/',
(localtime)[4] + 1, (localtime)[5] + 1900),
LINES => 8,
COLUMNS => 20,
@_
);
my @required = qw(X Y);
my $err = 0;
# Check for required arguments
foreach (@required) { $err = 1 unless exists $conf{$_} };
# Lowercase all colours
foreach (qw(HIGHLIGHTCOL HEADERCOL)) {
$conf{$_} = lc($conf{$_}) if exists $conf{$_} };
$err = 1 unless $self->SUPER::_conf(%conf);
return $err == 0 ? 1 : 0;
}
sub _content {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my $pos = $$conf{VALUE};
my @date = split(/\//, $$conf{MONTH});
my @highlight = @{ $$conf{HIGHLIGHT} };
my ($i, @cal);
# Get the calendar lines and print them
@cal = _gen_cal(@date[1,0]);
$i = 0;
foreach (@cal) {
# Set the header colour (if defined)
unless ($i > 1 || ! exists $$conf{HEADERCOL}) {
$dwh->attrset(COLOR_PAIR(
select_colour(@$conf{qw(HEADERCOL BACKGROUND)})));
$dwh->attron(A_BOLD) if $$conf{HEADERCOL} eq 'yellow';
}
# Save the cursor position if it's on this line
$self->{COORD} = [$i, length($1)] if $cal[$i] =~ /^(.*\b)$pos\b/;
# Print the calendar line
$dwh->addstr($i, 0, $cal[$i]);
# Highlight the necessary dates
if (exists $$conf{HIGHLIGHTCOL}) {
until ($#highlight == -1 || $cal[$i] !~ /^(.*\b)$highlight[0]\b/) {
$dwh->chgat($i, length($1), length($highlight[0]), 0,
select_colour(@$conf{qw(HIGHLIGHTCOL BACKGROUND)}), 0);
shift @highlight;
}
}
# Restore the default settings (if adjusted for headers or hightlights)
$self->_restore($dwh);
++$i;
}
}
sub _cursor {
my $self = shift;
my $dwh = shift;
my $conf = $self->{CONF};
my $pos = $$conf{VALUE};
my @highlight = @{$$conf{HIGHLIGHT}};
my ($y, $x) = @{$self->{COORD}};
my $fg;
# Determine the foreground colour
if (exists $$conf{HIGHLIGHTCOL}) {
$fg = (grep /^$pos$/, @highlight) ? $$conf{HIGHLIGHTCOL} :
$$conf{FOREGROUND};
} else {
$fg = $$conf{FOREGROUND};
}
# Display the cursor
$dwh->chgat($y, $x, length($pos), A_STANDOUT,
select_colour($fg, $$conf{BACKGROUND}), 0);
# Restore the default settings
$self->_restore($dwh);
}
sub _gen_cal {
# Generates the calendar month output, and stuffs it into a
# LOL, which is returned by the method.
#
# Modified from code provided courtesy of Michael E. Schechter,
# <mschechter@earthlink.net>
#
# Usage: @lines = $self->_gen_cal($year, $month);
my @date = @_;
my (@lines, @tmp, $i, @out);
# All of these local subroutines are essentially code to replicate
# the UNIX 'cal' command. My code parses the output to create the
# LOL.
local *print_month = sub {
my ($year, $month) = @_;
my @month = make_month_array($year, $month);
my @months = ('', qw(January February March April May June
July August September October November December));
my $days = 'Su Mo Tu We Th Fr Sa';
my ($title, $diff, $left, $day, $end, $x, $out);
$title = "$months[$month] $year";
$diff = 20 - length($title);
$left = $diff - int($diff / 2);
$title = ' ' x $left."$title";
$out = "$title\n$days";
$end = 0;
for ($x = 0; $x < scalar @month; $x++) {
$out .= "\n" if $end == 0;
$out .= "$month[$x]";
$end++;
if ($end > 6) {
$end = 0;
}
}
$out .= "\n";
return $out;
};
local *make_month_array = sub {
my ($year, $month) = @_;
my $firstweekday = day_of_week_num($year, $month, 1);
my (@month_array, $numdays, $remain, $x, $y);
$numdays = days_in_month($year, $month);
$y = 1;
for ($x = 0; $x < $firstweekday; $x++ ) { $month_array[$x] = ' ' };
if (! ($year == 1752 && $month == 9)) {
for ($x = 1; $x <= $numdays; $x++, $y++) {
$month_array[$x + $firstweekday - 1] = sprintf( "%2d ", $y);
}
} else {
for ($x = 1; $x <= $numdays; $x++, $y++) {
$month_array[$x + $firstweekday - 1] = sprintf( "%2d ", $y);
if ($y == 2) {
$y = 13;
}
}
}
return @month_array;
};
local *day_of_week_num = sub {
my ($year, $month, $day) = @_;
my ($a, $y, $m, $d);
$a = int( (14 - $month)/12 );
$y = $year - $a;
$m = $month + (12 * $a) - 2;
if (is_julian($year, $month)) {
$d = (5 + $day + $y + int($y/4) + int(31*$m/12)) % 7;
} else {
$d = ($day + $y + int($y/4) - int($y/100) + int($y/400) +
int(31*$m/12)) % 7;
}
return $d;
};
local *days_in_month = sub {
my ($year, $month) = @_;
my @month_days = ( 0,31,28,31,30,31,30,31,31,30,31,30,31 );
if ($month == 2 && is_leap_year($year)) {
$month_days[2] = 29;
} elsif ($year == 1752 && $month == 9) {
$month_days[9] = 19;
}
return $month_days[$month];
};
local *is_julian = sub {
my ($year, $month) = @_;
my $bool = 0;
$bool = 1 if ($year < 1752 || ($year == 1752 && $month <= 9));
return $bool;
};
local *is_leap_year = sub {
my $year = shift;
my $bool = 0;
if (is_julian($year, 1)) {
$bool = 1 if ($year % 4 == 0);
} else {
$bool = 1 if (($year % 4 == 0 && $year % 100 != 0) ||
$year % 400 == 0);
}
return $bool;
};
@out = split(/\n/, print_month(@date));
return @out;
}
sub input_key {
# Process input a keystroke at a time.
#
# Usage: $self->input_key($key);
my $self = shift;
my $in = shift;
my $conf = $self->{CONF};
my $pos = $$conf{VALUE};
my @date = split(/\//, $$conf{MONTH});
my @days = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
my ($y, $trigger);
# Adjust for leap years, if necessary
$days[2] += 1 if (($date[1] % 4 == 0 && $date[1] % 100 != 0) ||
$date[1] % 400 == 0);
$trigger = 'd';
# Navigate according to key press
if ($in eq KEY_LEFT) {
$pos -= 1;
} elsif ($in eq KEY_RIGHT) {
$pos += 1;
} elsif ($in eq KEY_UP) {
$pos -= 7;
} elsif ($in eq KEY_DOWN) {
$pos += 7;
} elsif ($in eq KEY_NPAGE) {
$pos += 28;
$pos += 7 if $pos <= $days[$date[0]];
} elsif ($in eq KEY_PPAGE) {
$pos -= 28;
$pos -= 7 if $pos > 0;
} elsif ($in eq KEY_HOME || $in eq KEY_FIND) {
($pos, @date) = (localtime)[3..5];
$date[0] += 1;
$date[1] += 1900;
# Key press wasn't a navigation key, so reset trigger
} else {
$trigger = '';
}
# Adjust the dates as necessary according to the cursor movement
if ($pos < 1) {
--$date[0];
if ($date[0] < 1) {
--$date[1];
$date[0] = 12;
}
$pos += $days[$date[0]];
} elsif ($pos > $days[$date[0]]) {
++$date[0];
if ($date[0] > 12) {
++$date[1];
$date[0] = 1;
}
$pos -= $days[$date[0] > 1 ? $date[0] - 1 : 12];
}
# Compare old info to the new and set trigger flags
$trigger .= 'm' if $date[0] != ($$conf{MONTH} =~ /^(\d+)/)[0];
$trigger .= 'y' if $date[1] != ($$conf{MONTH} =~ /(\d+)$/)[0];
# Save the adjusted dates
@$conf{qw(VALUE MONTH)} = ($pos, join('/', @date));
# Call the triggers
&{$$conf{ONDAY}}($self) if (defined $$conf{ONDAY} &&
$trigger =~ /d/);
&{$$conf{ONMONTH}}($self) if (defined $$conf{ONMONTH} &&
$trigger =~ /m/);
&{$$conf{ONYEAR}}($self) if (defined $$conf{ONYEAR} &&
$trigger =~ /y/);
}
1;