Curses-UI
view release on metacpan or search on metacpan
lib/Curses/UI/Calendar.pm view on Meta::CPAN
'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()
lib/Curses/UI/Calendar.pm view on Meta::CPAN
=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.
( run in 0.678 second using v1.01-cache-2.11-cpan-39bf76dae61 )