libcurses-ui-perl 0.9609-1 / usr / share / perl5 / Curses / UI / Calendar.pm

# ----------------------------------------------------------------------
# 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.
#
# Currently maintained by Marcus Thiesen
# e-mail: marcus@cpan.thiesenweb.de
# ----------------------------------------------------------------------

#TODO: fix dox

package Curses::UI::Calendar;

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

use vars qw(
    $VERSION 
    @ISA
);

$VERSION = '1.10';

@ISA = qw(
    Curses::UI::Widget 
    Curses::UI::Common
);

my @days   = ();
my @months = ();

my %routines = (
    'loose-focus'          => \&loose_focus,
    '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,
    'mouse-button'         => \&mouse_button,
);

my %bindings = (
    CUI_TAB()              => 'loose-focus',
    KEY_BTAB()             => 'loose-focus',
    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',
    "L",                   => 'date-nextyear',
    "H",                   => 'date-prevyear',
    "n",                   => 'date-nextyear',
    "p",                   => 'date-prevyear',
    KEY_HOME()             => 'date-selected',
    "\cA"                  => 'date-selected',
    "c"                    => 'date-selected',
    "t"                    => 'date-today',
    KEY_ENTER()            => 'date-select',
    CUI_SPACE()            => 'date-select',
);

# ----------------------------------------------------------------------
# Constructor
# ----------------------------------------------------------------------

sub new ()
{
    my $class = shift;

    my %userargs = @_;
    keys_to_lowercase(\%userargs);

    my %args = ( 
        -date       => undef,   # The date to start width
        -width      => 0,       # Widget will fix width itself
        -height     => 0,       # Widget will fix height itself
        -onchange   => undef,   # Event handler    
	-fg         => -1,
        -bg         => -1,
	-drawline   => 1,       # Draw a line under the widget?

        %userargs,

        -routines   => {%routines},
        -bindings   => {%bindings},

        -ipadleft   => 1,
        -ipadright  => 1,
        -ipadbottom => 0,
        -ipadtop    => 0,
        -focus      => 0,
        -nocursor   => 1,
    );

    # The widget 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 widget 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}, 1);

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

    # Load day- and monthnames.
    @days = $this->root->lang->getarray('days_short');
    @months = (undef, $this->root->lang->getarray('months'));

    if ($Curses::UI::ncurses_mouse) {
	$this->set_mouse_binding(
	    'mouse-button', BUTTON1_CLICKED(), BUTTON3_CLICKED());
    }

    return $this;
}

# ----------------------------------------------------------------------
# Methods
# ----------------------------------------------------------------------

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


sub layout()
{
    my $this = shift;
    $this->SUPER::layout() or return;    
    return $this;
}

sub setdate($;$)
{
    my $this = shift;
    my $date = shift;
    my $nodraw = shift || 0;

    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;
    $this->intellidraw unless $nodraw;

    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"} < 0)    { $this->{"-${c}year"}  = 0    }
    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;
    
    # Draw the widget
    $this->SUPER::draw(1) or return $this;
    
    $this->make_sane_date;
    $this->make_sane_date(1);
 
    # Let there be color
    if ($Curses::UI::color_support) {
	my $co = $Curses::UI::color_object;
	my $pair = $co->get_color_pair(
			     $this->{-fg},
			     $this->{-bg});

	$this->{-canvasscr}->attron(COLOR_PAIR($pair));

    }

    # Bold font on if the widget has focus and the selected
    # date is the active date.
    $this->{-canvasscr}->attron(A_BOLD) 
        if $this->{-focus} and
           $this->{-cyear} == $this->{-year} and
           $this->{-cmonth} == $this->{-month} and
           $this->{-cday} == $this->{-day};

    # 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->{-canvasscr}->addstr(0,0," "x$this->canvaswidth);
    $this->{-canvasscr}->addstr(0,0, $months[$this->{"-${c}month"}] 
                    . " " . $this->{"-${c}day"});
    $this->{-canvasscr}->addstr(0,$this->canvaswidth-4,$this->{"-${c}year"});

    # Draw daynames
    $this->{-canvasscr}->attron(A_BOLD) if $this->{-focus};
    $this->{-canvasscr}->addstr(2,0,join " ", @days);

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

    # Draw a line under the date.
    if ($this->{-drawline}) {
	$this->{-canvasscr}->move(1,0);
	$this->{-canvasscr}->hline(ACS_HLINE,$this->canvaswidth);
    }

    # Create the list of days in the current month.
    my @month = build_month($this->{"-${c}year"}, $this->{"-${c}month"});

    # Draw the days.
    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.
        $this->{-canvasscr}->attron(A_BOLD)
            if $this->{-day}    == $day   and 
	       $this->{-month}  == $month and
	       $this->{-year}   == $year;
    
        # Make selected date inverse if widget has focus.
        $this->{-canvasscr}->attron(A_REVERSE)
	    if $this->{-focus}            and
               $this->{-cday}   == $day   and 
	       $this->{-cmonth} == $month and
	       $this->{-cyear}  == $year;

        # Draw the day.
        $this->{-canvasscr}->addstr($y, $weekday*3, sprintf("%2d",$day));

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

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

    # Move the cursor to the bottomright corner of the widget
    # (in case the terminal does not support widget hiding).
    $this->{-canvasscr}->move($this->canvasheight-1, $this->canvaswidth-1);

    $this->{-canvasscr}->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->schedule_draw(1);
    return $this;
}

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

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

sub date_nextyear()
{
    my $this = shift;
    $this->{-cyear}++;
    $this->{-cyear} = 9999 if $this->{-cyear} > 9999;
    $this->schedule_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->schedule_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->schedule_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) 
        {
            if ( ($this->{-cmonth} >= 1 and $this->{-cyear} >= 1) or
                 ($this->{-cmonth} >= 2 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);
        }
    }
    $this->schedule_draw(1);
}

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

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

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

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

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

sub mouse_button($$$$;)
{
    my $this  = shift;
    my $event = shift;
    my $x     = shift;
    my $y     = shift;

    # Click in the day area?
    if ($y > 3 and $y < 10) 
    {
	my @month = build_month($this->{-cyear}, $this->{-cmonth});
	my $weekday = 0;
	my $ty      = 4;
	foreach my $day (@month)
	{
	    unless (defined $day) { $weekday++; next }

	    my ($dx, $dy) = ($weekday*3, $ty);

	    if ($x >= $dx and $x < $dx+2 and $y == $dy) {
		$this->{-cday} = $day;
		$this->date_select(1);
		$this->focus();
		last;
	    }

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

    # Click on the year?
    elsif ($y == 0 and 
	   $x > ($this->canvaswidth-5) and
	   $x < $this->canvaswidth) 
    {
        # Select year
	if ( $event->{-bstate} == BUTTON3_CLICKED() ) {
	    $this->date_nextyear;
	} else {
	    $this->date_prevyear;
	}
	$this->focus();
    }
    
    # Click on the month?
    elsif ( $y == 0 and 
	    $x >= 0 and
	    $x < length($months[$this->{-cmonth}]) )
    {
	if ( $event->{-bstate} == BUTTON3_CLICKED() ) {
	    $this->date_nextmonth;
	} else {
	    $this->date_prevmonth;
	}
	$this->focus();
    }


    
    return $this;
}

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

# ----------------------------------------------------------------------
# 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 CLASS HIERARCHY

 Curses::UI::Widget
    |
    +----Curses::UI::Calendar


=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>, B<-onfocus>,
B<-onblur>

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)

=item * B<-onchange> < CODEREF >

This sets the onChange event handler for the calendar widget.
If a new date is selected, the code in CODEREF will be executed.
It will get the widget reference as its argument.

=item * B<-drawline> < CODEREF >

This option specifies whether or not a line should be drawn under
the calendar.

=back




=head1 METHODS

=over 4

=item * B<new> ( OPTIONS )

=item * B<layout> ( )

=item * B<draw> ( BOOLEAN )

=item * B<focus> ( )

=item * B<onFocus> ( CODEREF )

=item * B<onBlur> ( CODEREF )

=item * B<intellidraw> ( )

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, [BOOLEAN] )

Set the selected date of the widget to DATE. See B<-date> above for
the possible formats. The widget will redraw itself, unless BOOLEAN
has a true value.

=item * B<onChange> ( CODEREF )

This method can be used to set the B<-onchange> event handler
(see above) after initialization of the calendar. 

=back




=head1 DEFAULT BINDINGS

=over 4

=item * <B<tab>>

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

=item * <B<enter>>, <B<space>>

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<SHIFT+K>>

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

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

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

=item * <B<p>>, <B<SHIFT+H>>

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

=item * <B<n>>, <B<SHIFT+L>>

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.

Maintained by Marcus Thiesen (marcus@cpan.thiesenweb.de)


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.