#
# This file is part of Curses-Toolkit
#
# This software is copyright (c) 2011 by Damien "dams" Krotkine.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use warnings;
use strict;
package Curses::Toolkit::Widget::HScrollBar;
{
$Curses::Toolkit::Widget::HScrollBar::VERSION = '0.211';
}
# ABSTRACT: an horizontal scrollbar widget
use parent qw(Curses::Toolkit::Widget::ScrollBar);
use Params::Validate qw(SCALAR ARRAYREF HASHREF CODEREF GLOB GLOBREF SCALARREF HANDLE BOOLEAN UNDEF validate validate_pos);
our @EXPORT_OK = qw(HScrollBar);
our %EXPORT_TAGS = (all => [qw(HScrollBar)]);
sub HScrollBar { 'Curses::Toolkit::Widget::HScrollBar' }
sub new {
my $class = shift;
my $self = $class->SUPER::new();
$self->{visibility_mode} = 'auto';
$self->{scroll_area} = undef;
$self->add_event_listener(
Curses::Toolkit::EventListener->new(
accepted_events => {
'Curses::Toolkit::Event::Mouse::Click' => sub {
my ($event) = @_;
$event->{button} eq 'button1' or return 0;
$self->{_pressed} && $event->{type} eq 'released'
and return 1;
$self->{_pressed}
and return 0;
$event->{type} eq 'pressed'
or return 0;
my $scroll_delta = 1;
my $c = $event->{coordinates};
my $wc = $self->get_coordinates();
$c->get_x1() == $wc->get_x1() || $c->get_x1() == $wc->get_x2() - 1
or return 0;
$c->get_x1() == $wc->get_x1()
or $scroll_delta = -$scroll_delta;
$event->custom_data->{scroll_delta} = $scroll_delta;
return 1;
},
},
code => sub {
my ( $event, $hscrollbar ) = @_;
if ($self->{_pressed}) {
# means we released it
$hscrollbar->unset_modal();
$self->{_pressed} = 0;
$self->{_scrolling}{enabled} = 0;
return;
}
# means we pressed it
$hscrollbar->set_modal();
my $scroll_area = $hscrollbar->get_scroll_area;
defined $scroll_area
or return;
my $scroll_delta = $event->custom_data->{scroll_delta};
$scroll_area->scroll(x => $scroll_delta);
$self->{_pressed} = 1;
$self->{_scrolling}{enabled} = 1;
$self->{_scrolling}{scroll_delta} = $scroll_delta;
$self->_start_scrolling_animation();
return;
},
)
);
$self->add_event_listener(
Curses::Toolkit::EventListener->new(
accepted_events => {
'Curses::Toolkit::Event::Mouse::Click' => sub {
my ($event) = @_;
$event->{button} eq 'button1' or return 0;
my $scroll_delta = 0;
$event->{type} eq 'clicked'
and $scroll_delta = 1;
$event->{type} eq 'double_clicked'
and $scroll_delta = 2;
$event->{type} eq 'triple_clicked'
and $scroll_delta = 3;
$scroll_delta or return 0;
my $c = $event->{coordinates};
my $wc = $self->get_coordinates();
$c->get_x1() == $wc->get_x1() || $c->get_x1() == $wc->get_x2() - 1
or return 0;
$c->get_x1() == $wc->get_x1()
or $scroll_delta = -$scroll_delta;
$event->custom_data->{scroll_delta} = $scroll_delta;
return 1;
},
},
code => sub {
my ( $event, $hscrollbar ) = @_;
my $scroll_area = $hscrollbar->get_scroll_area;
defined $scroll_area
or return;
my $scroll_delta = $event->custom_data->{scroll_delta};
$scroll_area->scroll(x => $scroll_delta);
return;
},
)
);
return $self;
}
sub _start_scrolling_animation {
my ($self) = @_;
my $root_window = $self->get_root_window();
my $delay = 1/8;
my $delay_sub;
$delay_sub = sub {
$self->{_scrolling}{enabled}
or return;
my $scroll_area = $self->get_scroll_area;
defined $scroll_area
or return;
my $scroll_delta = $self->{_scrolling}{scroll_delta};
$scroll_area->scroll(x => $scroll_delta);
my $root_window = $self->get_root_window();
$root_window->add_delay( $delay, $delay_sub );
};
$root_window->add_delay( $delay, $delay_sub );
return;
}
# attach the scrollbar to a given scroll area
sub set_scroll_area {
my ($self, $scroll_area) = @_;
$self->{scroll_area} = $scroll_area;
return $self;
}
sub get_scroll_area {
my ($self) = @_;
return $self->{scroll_area};
}
sub draw {
my ($self) = @_;
$self->is_visible
or return;
my $theme = $self->get_theme();
my $c = $self->get_coordinates();
my $fill = $self->get_fill();
my $fill_width = $fill * ($c->width()-2);
$theme->draw_string( $c->get_x1(), $c->get_y1(), '<');
foreach my $x (0..$fill_width) {
$theme->draw_resize( $c->get_x1() +1+$x , $c->get_y1(),);
}
# $theme->draw_hline( $c->get_x1()+1+$fill_width+1, $c->get_y1(), $c->height()-2-$fill_height);
$theme->draw_string( $c->get_x2()-1, $c->get_y1(), '>');
return;
}
sub possible_signals {
my ($self) = @_;
return (
$self->SUPER::possible_signals(),
scrolled_up => 'Curses::Toolkit::Signal::Scrolled::Left',
scrolled_down => 'Curses::Toolkit::Signal::Scrolled::Right',
);
}
1;
__END__
=pod
=head1 NAME
Curses::Toolkit::Widget::HScrollBar - an horizontal scrollbar widget
=head1 VERSION
version 0.211
=head1 DESCRIPTION
This widget is just the horizontal scrollbar. Usually you will want to use
Curses::Toolkit::Widget::ScrollArea. It inherits from Curses::Toolkit::Widget::ScrollBar.
=head1 CONSTRUCTOR
=head2 new
input : none
output : a Curses::Toolkit::Widget::HScrollBar object
=head1 AUTHOR
Damien "dams" Krotkine
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by Damien "dams" Krotkine.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut