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::Event::Mouse::Click;
BEGIN {
  $Curses::Toolkit::Event::Mouse::Click::VERSION = '0.207';
}

# ABSTRACT: event that is related to mouse click

use parent qw(Curses::Toolkit::Event::Mouse);

use Params::Validate qw(SCALAR ARRAYREF HASHREF CODEREF GLOB GLOBREF SCALARREF HANDLE BOOLEAN UNDEF validate validate_pos);


sub new {
    my $class = shift;
    my $self  = $class->SUPER::new();
    my %args  = validate(
        @_,
        {   type => {
                type      => SCALAR,
                callbacks => {
                    'must be one of ' . join( ', ', $self->get_possible_types() ) => sub {
                        my %h = map { $_ => 1 } $self->get_possible_types(); $h{ $_[0] };
                    },
                },
            },
            button => {
                type      => SCALAR,
                callbacks => {
                    'must be one of ' . join( ', ', $self->get_possible_buttons() ) => sub {
                        my %h = map { $_ => 1 } $self->get_possible_buttons(); $h{ $_[0] };
                    },
                },
            },
            coordinates => { isa => 'Curses::Toolkit::Object::Coordinates' },
            root_window => { isa => 'Curses::Toolkit' },
        }
    );
    $self = bless( \%args, $class );
    return $self;
}

sub get_possible_types {
    my ($self) = @_;
    return qw(pressed released clicked double_clicked triple_clicked shift ctrl alt);
}

sub get_possible_buttons {
    my ($self) = @_;
    return qw(button1 button2 button3 button4 button5 button);
}


sub get_matching_widget {
    my ($self) = @_;

    my $recurse;
    $recurse = sub {
        my $deepness = shift;
        my $stack    = shift;
        $deepness++;
        my @result = map {
            my $stack = ( $_->isa('Curses::Toolkit::Widget::Window') ? $_->get_property( window => 'stack' ) : $stack );
            [   $deepness,
                $stack,
                $_
            ],
                ( $_->can('get_children') ? $recurse->( $deepness, $stack, $_->get_children() ) : () )
        } @_;
        return @result;
    };

    my @all_widgets = $recurse->( 0, 0, $self->{root_window}->get_windows() );

    # sort by window stack then deepnes in the widget tree
    @all_widgets =
        sort { $b->[1] <=> $a->[1] || $b->[0] <=> $a->[0] }
        grep { $self->{coordinates}->is_in_widget_visible_shape( $_->[2] ) } @all_widgets;

    foreach my $w (@all_widgets) {
        my $n = $w->[2];
        use Data::Dumper;
    }

    @all_widgets and return $all_widgets[0]->[2];
    return $self->{root_window};
}

1;

__END__
=pod

=head1 NAME

Curses::Toolkit::Event::Mouse::Click - event that is related to mouse click

=head1 VERSION

version 0.207

=head1 DESCRIPTION

Event that is related to mouse click

=head1 CONSTRUCTOR

=head2 new

  input : type   : a type of mouse click. STRING, can be one of (see below)
          button : the button that was clicked. STRING, can be (see below) 
          coordinates : Curses::Toolkit::Object::Coordinates : where the click happened
          root_window : Curses::Toolkit : the root window object
  
  type can be one of :
  pressed released clicked double_clicked
  triple_clicked shift ctrl alt

  button can be one of :
  button1 button2 button3 button4 button5 button

=head2 get_matching_widget

Returns the widget that is affected by the event. In this case, it returns the
widget where the click were done

  input  : none
  output : the widget that is affected by the event

=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