The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# 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.208';
}

# 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.208

=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