# ----------------------------------------------------------------------
# Curses::UI::Calendar
#
# (c) 2001-2002 by Maurice Makaay. All rights reserved.
# This file is part of Curses::UI. Curses::UI is free software.
# You can redistribute it and/or modify it under the same terms
# as perl itself.
#
# e-mail: maurice@gitaar.net
# ----------------------------------------------------------------------

package Curses::UI::Calendar;

use strict;
use Curses;
use Curses::UI::Common;
use Curses::UI::Widget;

use vars qw($VERSION @ISA @EXPORT);
require Exporter;
@ISA = qw(Curses::UI::Widget Curses::UI::Common);
$VERSION = '1.03';

my @days   = (
	'Su', 'Mo', 'Tu', 
	'We', 'Th', 'Fr', 'Sa'
);
my @months = (
	undef,
	'Januari', 'Februari', 'March', 'April',
	'May', 'June', 'July', 'August',
	'September', 'October', 'November', 'December'
);

my %routines = (
	'return'		=> 'RETURN',
	'date-select'		=> \&date_select,
	'date-selected'		=> \&date_selected,
	'date-nextday'		=> \&date_nextday,
	'date-prevday'		=> \&date_prevday,
	'date-nextweek'		=> \&date_nextweek,
	'date-prevweek'		=> \&date_prevweek,
	'date-nextmonth'	=> \&date_nextmonth,
	'date-prevmonth'	=> \&date_prevmonth,
	'date-nextyear'		=> \&date_nextyear,
	'date-prevyear'		=> \&date_prevyear,
	'date-today'		=> \&date_today,
);

my %bindings = (
        KEY_TAB()            	=> 'return',
        KEY_LEFT()      	=> 'date-prevday',
        "h"             	=> 'date-prevday',
        KEY_RIGHT()     	=> 'date-nextday',
        "l"             	=> 'date-nextday',
        KEY_DOWN()      	=> 'date-nextweek',
	"j"			=> 'date-nextweek',
        KEY_UP()        	=> 'date-prevweek',
        "k"             	=> 'date-prevweek',
        KEY_NPAGE()     	=> 'date-nextmonth',
	"J",			=> 'date-nextmonth',
        KEY_PPAGE()     	=> 'date-prevmonth',
	"K",			=> 'date-prevmonth',
	"n",			=> 'date-nextyear',
	"p",			=> 'date-prevyear',
        KEY_HOME()      	=> 'date-selected',
        "\cA"           	=> 'date-selected',
        "c" 	          	=> 'date-selected',
        "t"           		=> 'date-today',
	KEY_ENTER()		=> 'date-select',
        KEY_SPACE()            	=> 'date-select',
);

sub new ()
{
	my $class = shift;

	my %args = ( 
		-date	    => undef,   # The date to start width
		-width      => 0,
		-height     => 0,
		@_,
		-ipadleft   => 1,
		-ipadright  => 1,
		-ipadbottom => 0,
		-ipadtop    => 0,
		-routines   => {%routines},
		-bindings   => {%bindings},
	);

	# The width should be at least 20.
	my $min_width = width_by_windowscrwidth(20, %args);
	$args{-width} = $min_width if $args{-width} != -1 
				   and $args{-width} < $min_width;
	
	# The height should be at least 11.
	my $min_height = height_by_windowscrheight(11, %args);
	$args{-height} = $min_height if $args{-height} != -1
			 	     and $args{-height} < $min_height;

	my $this = $class->SUPER::new( %args );	

	# Split up and fix the date.
	$this->setdate($this->{-date});

	# Set cursor to current date.
	$this->{-cyear} = $this->{-year};
	$this->{-cmonth} = $this->{-month};
	$this->{-cday} = $this->{-day};

	bless $this, $class;
}

sub layout()
{
	my $this = shift;
	return $this if $Curses::UI::screen_too_small;
	
	$this->SUPER::layout();	
	
	return $this;
}

sub setdate($;)
{
	my $this = shift;
	my $date = shift;
	
	if (not defined $date)
	{
		$this->{-year}  = undef;
		$this->{-month} = undef;
		$this->{-day}   = undef;
	}
	elsif ($date =~ /^(\d\d\d\d+)(\d\d)(\d\d)$/)
	{
		$this->{-year}  = $1;
		$this->{-month} = $2;
		$this->{-day}   = $3;
	}
	elsif ($date =~ /^(\d{1,2})\D(\d{1,2})\D(\d\d\d\d+)$/)
	{
		$this->{-year}  = $3;
		$this->{-month} = $2;
		$this->{-day}   = $1;
	}
	elsif ($date =~ /^(\d\d\d\d+)\D(\d{1,2})\D(\d{1,2})$/)
	{
		$this->{-year}  = $1;
		$this->{-month} = $2;
		$this->{-day}   = $3;
	}

	$this->make_sane_date;

	return $this;
}

sub make_sane_date()
{
	my $this = shift;
	my $cursor = shift;
	my $c = $cursor ? 'c' : '';
	
	# Determine 'today'.
	my @now = localtime(); $now[4]++; $now[5]+=1900;

	# Use today's values if undefined.
	$this->{"-${c}day"}   = $now[3] 
		unless defined $this->{"-${c}day"};
	$this->{"-${c}month"} = $now[4] 
		unless defined $this->{"-${c}month"};
	$this->{"-${c}year"}  = $now[5] 
		unless defined $this->{"-${c}year"};


	if ($this->{"-${c}year"} < 1)    { $this->{"-${c}year"}  = 1    }
	if ($this->{"-${c}year"} > 9999) { $this->{"-${c}year"}  = 9999 }
	if ($this->{"-${c}month"} < 1)   { $this->{"-${c}month"} = 1    }
	if ($this->{"-${c}month"} > 12)  { $this->{"-${c}month"} = 12   }

	my $days = days_in_month($this->{"-${c}year"}, $this->{"-${c}month"});
	if ($this->{"-${c}day"} < 1)     { $this->{"-${c}day"} = 1     }
	if ($this->{"-${c}day"} > $days) { $this->{"-${c}day"} = $days }
	
	# undef value?
	if ($this->{"-${c}year"} == 1752 and $this->{"-${c}month"} == 9) {
		if ($this->{"-${c}day"} > 2 and $this->{"-${c}day"} < 14) {
			$this->{"-${c}day"} = ($this->{"-${c}day"} > 8 ? 14 : 2);
		}
	}

	return $this;
}

sub draw(;$)
{
	my $this = shift;
	my $no_doupdate = shift || 0;

        # Return immediately if this object is hidden.
        return $this if $this->hidden;
	
	# Draw the widget
	$this->SUPER::draw(1);
	
	$this->make_sane_date;
	$this->make_sane_date(1);

	# Bold font on if the widget has focus.
	$this->{-windowscr}->attron(A_BOLD) if $this->{-focus};

	# Draw day, month and year. If the widget has focus,
	# show the cursor position. Else show the selected position.
	my $c = $this->{-focus} ? 'c' : '';	
	$this->{-windowscr}->addstr(0,0," "x$this->screenwidth);
	$this->{-windowscr}->addstr(0,0, $months[$this->{"-${c}month"}] 
					. " " . $this->{"-${c}day"});
	$this->{-windowscr}->addstr(0,$this->screenwidth-4,$this->{"-${c}year"});
	# Draw daynames
	$this->{-windowscr}->addstr(2,0,join " ", @days);

	# Reset bold font attribute.
	$this->{-windowscr}->attroff(A_BOLD) if $this->{-focus};

	$this->{-windowscr}->move(1,0);
	$this->{-windowscr}->hline(ACS_HLINE,$this->screenwidth);

	my @month = build_month($this->{"-${c}year"}, $this->{"-${c}month"});

	my $month = $this->{"-${c}month"};
	my $year  = $this->{"-${c}year"};
	
	my $y = 4; 
	my $weekday = 0;
	foreach my $day (@month)
	{
		unless (defined $day) {
			$weekday++;
			next;
		}

		# Make current date bold.
		if ($this->{-day}   == $day and 
                    $this->{-month} == $month and
		    $this->{-year}  == $year) {
		    $this->{-windowscr}->attron(A_BOLD)
		}
	
		# Make selected date inverse if widget has focus.
		if ($this->{-cday}   == $day and 
                    $this->{-cmonth} == $month and
                    $this->{-cyear}  == $year and
                    $this->{-focus}) {
			$this->{-windowscr}->attron(A_REVERSE)
		}

		$this->{-windowscr}->addstr($y, $weekday*3, sprintf("%2d",$day));

		# Reset attributes.
		$this->{-windowscr}->attroff(A_REVERSE);
		$this->{-windowscr}->attroff(A_BOLD);

		$weekday++;
		if ($weekday == 7) {
			$weekday = 0;
			$y++;
		}
	}

	$this->{-windowscr}->noutrefresh();
	doupdate() unless $no_doupdate;

	return $this;
}

sub date_selected()
{
	my $this = shift;
	$this->{-cyear} = $this->{-year};
	$this->{-cmonth} = $this->{-month};
	$this->{-cday} = $this->{-day};
	$this->draw(1);
	return $this;
}

sub date_today()
{
	my $this = shift;
	$this->{-cmonth} = undef;
	$this->{-cday}   = undef;
	$this->{-cyear}  = undef;
	$this->draw(1);
	return $this;
}

sub date_prevyear()
{
	my $this = shift;
	$this->{-cyear}--;
	$this->{-cyear} = 0 if $this->{-cyear} < 0;
	$this->draw(1);
	return $this;
}

sub date_nextyear()
{
	my $this = shift;
	$this->{-cyear}++;
	$this->{-cyear} = 9999 if $this->{-cyear} > 9999;
	$this->draw(1);
	return $this;
}

sub date_prevmonth()
{
	my $this = shift;
	$this->{-cmonth}--;
	if ($this->{-cmonth} < 1 and $this->{-cyear} > 0) {
		$this->{-cmonth} = 12;
		$this->{-cyear}--;
	}
	$this->draw(1);
	return $this;
}

sub date_nextmonth()
{
	my $this = shift;
	$this->{-cmonth}++;
	if ($this->{-cmonth} > 12 and $this->{-cyear} < 9999) {
		$this->{-cmonth} = 1;
		$this->{-cyear}++;
	}
	$this->draw(1);
	return $this;
}

sub date_delta_days($;)
{
	my $this = shift;
	my $delta = shift;

	if ($delta < 0) 
	{
		my $startday = $this->{-cday};
		$this->{-cday} += $delta;
		if ($this->{-cday} < 1 and 
		    $this->{-cmonth} >= 1 and 
		    $this->{-cyear} >= 0) 
		{
			$this->date_prevmonth();
			my $days = days_in_month($this->{-cyear}, $this->{-cmonth}); 
		   	$this->{-cday} = $startday + $delta + $days;
		}
	} else {
		my $days = days_in_month($this->{-cyear}, $this->{-cmonth});
		my $newday = $this->{-cday} + $delta - $days; 
		$this->{-cday} += $delta;
		if ($this->{-cday} > $days and 
		    $this->{-cyear} < 9999)
		{
			$this->date_nextmonth();
			$this->{-cday} = $newday;
		}
	}
	
	if ($this->{-cyear} == 1752 and $this->{-cmonth} == 9) {
		if ($this->{-cday} > 2 and $this->{-cday} < 14) {
			$this->{-cday} = ($delta > 0 ? 14 : 2);
		}
	}
	
}

sub date_prevweek()
{
	my $this = shift;
	$this->date_delta_days(-7);
	$this->draw(1);
	return $this;
}

sub date_nextweek()
{
	my $this = shift;
	$this->date_delta_days(+7);
	$this->draw(1);
	return $this;
}

sub date_prevday()
{
	my $this = shift;
	$this->date_delta_days(-1);
	$this->draw(1);
	return $this;
}

sub date_nextday()
{
	my $this = shift;
	$this->date_delta_days(+1);
	$this->draw(1);
	return $this;
}

sub date_select()
{
	my $this = shift;	
	$this->{-day}   = $this->{-cday};
	$this->{-month} = $this->{-cmonth};
	$this->{-year}  = $this->{-cyear};
	$this->draw(1);
	return $this;
}

sub day($;)   { shift()->accessor('-day',   shift()) }
sub month($;) { shift()->accessor('-month', shift()) }
sub year($;)  { shift()->accessor('-year',  shift()) }

sub get()
{
	my $this = shift;
	$this->make_sane_date();
	return sprintf("%04d-%02d-%02d", 
		       $this->{-year}, $this->{-month}, $this->{-day});
}

sub focus()
{
	my $this = shift;

	$this->show;
	
	return $this->generic_focus(
		undef,
		NO_CONTROLKEYS,
		CURSOR_INVISIBLE
	);
}

# ----------------------------------------------------------------------
# Date calculation 
# ----------------------------------------------------------------------

my @days_in_month = (undef,31,28,31,30,31,30,31,31,30,31,30,31);

sub is_julian ($$;)
{
	my ($year, $month) = @_;
	return $year < 1752 or ($year == 1752 and $month <= 9);
}

sub day_of_week($$$;)
{
	my $year  = shift;
	my $month = shift;
	my $day   = shift;

	my $a = int( (14 - $month)/12 );
	my $y = $year - $a;
	my $m = $month + (12 * $a) - 2;
	my $day_of_week;
	if (is_julian($year, $month)) 
	{
		$day_of_week = (
				5 
				+ $day 
				+ $y + int($y/4) 
				+ int(31*$m/12)	
			       ) % 7;
	} else {
		$day_of_week = (
				$day 
				+ $y + int($y/4) 
				- int($y/100) 
				+ int($y/400) 
				+ int(31*$m/12)
			       ) % 7;
	}

	return $day_of_week;
}

sub days_in_month($$;) 
{
	my $year  = shift;
	my $month = shift;

	if($month == 2 and is_leap_year($year)) {
		return 29;
	} else {
		return $days_in_month[$month];
	}
}

sub is_leap_year($;)
{
	my $year = shift;

	if (is_julian($year,1)) {
		return 1 if $year % 4 == 0;
	} else {
		return 1 if ($year % 4 == 0 and $year % 100 != 0) 
                  	    or $year % 400 == 0;
	}
	return 0;
}

sub build_month ($$;)
{
	my $year  = shift;
	my $month = shift;

	my $first_weekday = day_of_week($year, $month, 1);
	my $number_of_days = days_in_month($year, $month);
	
	if ($year == 1752 and $month == 9) {
		$number_of_days = 19;
	}

	my @month = ();
	for (1..$first_weekday) {
		push @month, undef;
	}

	my $realday = 1;
	for( my $day = 1; $day <= $number_of_days; $day++ )
	{
		push @month, $realday;
		if ($year == 1752 and $month == 9 and $realday == 2) {
			$realday = 13;
		}
		$realday++;
	}

	return @month;
}


1;


=pod

=head1 NAME

Curses::UI::Calendar - Create and manipulate calendar widgets

=head1 SYNOPSIS

    use Curses::UI;
    my $cui = new Curses::UI;
    my $win = $cui->add('window_id', 'Window');

    my $calendar = $win->add(
        'mycalendar', 'Calendar',
	-date    => '2002-1-14'
    );

    $calendar->focus();
    my $date = $calendar->get();


=head1 DESCRIPTION

Curses::UI::Calendar is a widget that can be used to create 
a calendar in which the user can select a date. The calendar
widget looks like this:
	
  +----------------------+
  | mmm dd          yyyy | 
  +----------------------+
  | su mo tu we th fr sa |
  |                      |
  |       01 02 03 04 05 |
  | 06 07 08 09 10 11 12 |
  | 13 14 15 16 17 18 19 |
  | 20 21 22 23 24 25 26 |
  | 27 28 29 30 31       |
  +----------------------+

See exampes/demo-Curses::UI::Calendar in the distribution
for a short demo.



=head1 STANDARD OPTIONS

B<-parent>, B<-x>, B<-y>, B<-width>, B<-height>, 
B<-pad>, B<-padleft>, B<-padright>, B<-padtop>, B<-padbottom>,
B<-ipad>, B<-ipadleft>, B<-ipadright>, B<-ipadtop>, B<-ipadbottom>,
B<-title>, B<-titlefullwidth>, B<-titlereverse>

For an explanation of these standard options, see 
L<Curses::UI::Widget|Curses::UI::Widget>.

B<Remark>: B<-width> and B<-height> can be set, but this widget 
really want to have its content space at a minimum size. If your
B<-width> or B<-height> is not large enough, the widget will
automatically fix its value.




=head1 WIDGET-SPECIFIC OPTIONS

=over 4

=item * B<-date> < DATE >

This option sets the date to start with. 
If you do not specify a date, today's 
date will be used automatically. The format that 
you can use for this date is one of:

* B<YYYY-M-D> (e.g. 2002-1-10 or 2002-01-10)

* B<YYYY/M/D> (e.g. 2002/1/10 or 2002/01/10))

* B<YYYYMMDD> (e.g. 20020110)

* B<D-M-YYYY> (e.g. 10-1-2002 or 10/01/2002)

* B<D/M/YYYY> (e.g. 10/1/2002 or 10/01/2002)


=back




=head1 METHODS

=over 4

=item * B<new> ( OPTIONS )

=item * B<layout> ( )

=item * B<draw> ( BOOLEAN )

=item * B<focus> ( )

These are standard methods. See L<Curses::UI::Widget|Curses::UI::Widget> 
for an explanation of these.

=item * B<get> ( )

This method will return the currently selected date in the
format 'YYYY-MM-DD'.

=item * B<setdate> ( DATE )

Set the selected date of the widget to DATE. See B<-date> above for
the possible formats. You will have to call the B<draw> method to
see the change.

=back




=head1 DEFAULT BINDINGS

=over 4

=item * <B<tab>>

Call the 'return' routine. This will have the menubar
loose its focus and return the value 'RETURN' to
the calling routine.

=item * <B<enter>>

Call the 'date-select' routine. This will select the date on
which the cursor is.

=item * <B<cursor-left>>, <B<h>>

Call the 'date-prevday' routine. This will have the date 
cursor go back one day.

=item * <B<cursor-right>, <B<l>>

Call the 'date-nextday' routine. This will have the 
date cursor go forward one day.

=item * <B<cursor-down>>, <B<j>>

Call the 'date-nextweek' routine. This will have the 
date cursor go forward one week.

=item * <B<cursor-up>>, <B<k>>

Call the 'date-prevweek' routine. This will have the 
date cursor go back one week.

=item * <B<page-up>>, <B<K>>

Call the 'date-prevmonth' routine. This will have the 
date cursor go back one month.

=item * <B<page-down>>, <B<J>>

Call the 'date-nextmonth' routine. This will have the 
date cursor go forward one month.

=item * <B<p>>

Call the 'date-prevyear' routine. This will have the 
date cursor go back one year.

=item * <B<n>>

Call the 'date-nextyear' routine. This will have the 
date cursor go forward one year.

=item * <B<home>>, <B<CTRL+A>>, <B<c>>

Call the 'date-selected' routine. This will have the 
date cursor go to the current selected date.

=item * <B<t>>

Call the 'date-today' routine. This will have the date cursor
go to today's date.

=back 





=head1 SEE ALSO

L<Curses::UI|Curses::UI>, 
L<Curses::UI::Widget|Curses::UI::Widget>, 
L<Curses::UI::Common|Curses::UI::Common>




=head1 AUTHOR

Copyright (c) 2001-2002 Maurice Makaay. All rights reserved.

This package is free software and is provided "as is" without express
or implied warranty. It may be used, redistributed and/or modified
under the same terms as perl itself.

