package Tk::ListBrowser::BaseItem;

=head1 NAME

Tk::ListBrowser::BaseItem - Base class for Item and SideColumn.

=cut

use strict;
use warnings;
use vars qw($VERSION $AUTOLOAD);
use Carp;

$VERSION =  0.15;

=head1 SYNOPSIS

You never do this yourself. But this is how it works.

 my $base = Tk::ListBrowser::BaseItem->new(%options,
    -name => $name,
    -listbrowser => $reftolistbrowserobject,
 );


=head1 DESCRIPTION

Provides a base class for modules L<Tk::ListBrowser::Item> and L<Tk::ListBrowser::SidePanel>.
It provides a method overload to the L<Tk::ListBrowser> object.

Available options are I<-background>, I<-drawrect>, I<-font>, I<-foreground>, I<-owner>,
I<-itemtype>, I<-textanchor>, I<-textjustify>, I<-textlength>,  I<-textside> and I<-wraplength>.

The I<-owner> option specifies which object (side column or ListBrowser widget)
is holding this item. By default it is set to the ListBrowser widget.

The I<-drawrect> option specifies whether a rectangle, in the background color should be drawn
as area indicator.

If an option is not defined this module will look for the corresponding option in it's owner.

=head1 METHODS

=over 4

=cut

sub new {
	my $class = shift;
	
	my %args = @_;

	my $lb = delete $args{'-listbrowser'};
	croak 'You did not specify a listbrowser' unless defined $lb;

	my $name = delete $args{'-name'};
	croak 'You did not specify a name' unless defined $name;


	my $self = {	
		ISMAPPED => '',
		LISTBROWSER => $lb,
		NAME => $name,
		REGION => [0, 0, 0, 0],
	};
	bless($self, $class);
	
	my %configset;
	for (keys %args) {
		$self->configure($_, $args{$_});
		$configset{$_} = 1;
	}
	$self->{CONFIGSET} = \%configset;

	$self->drawrect(0) unless defined $self->drawrect;
	$self->owner($self->listbrowser) unless defined $self->owner;

	return $self
}

sub AUTOLOAD {
	my $self = shift;
	return if $AUTOLOAD =~ /::DESTROY$/;
	$AUTOLOAD =~ s/^.*:://;
	return $self->{LISTBROWSER}->$AUTOLOAD(@_);
}

sub background {
	my $self = shift;
	$self->{BACKGROUND} = shift if @_;
	return $self->{BACKGROUND} if defined $self->{BACKGROUND};
	return $self->owner->cget('-background')
}

=item B<cget>I<($option)>

Returns the value of option I<$option>.

=cut

sub cget {
	my ($self, $option) = @_;
	my $d = quotemeta('-');
	$option =~ s/^$d//;
	if ($self->can($option)) {
		return $self->$option
	} else {
		return $self->listbrowser->cget("-$option")
	}
}


=item B<clear>

Clears all visible items on the canvas belonging to this item.

=cut

sub clear {
	my $self = shift;
	my $c = $self->Subwidget('Canvas');
	$self->ismapped('');
	$self->region(0, 0, 0, 0);
	my $rect = $self->crect;
	$c->delete($rect) if defined $rect;
	$self->crect(undef);
}

=item B<configure>I<(%options)>

Configures I<%options>.

=cut

sub configure {
	my ($self, %options) = @_;
	my $d = quotemeta('-');
	for (keys %options) {
		my $option = $_;
		my $value = $options{$option};
		$option =~ s/^$d//;
		if ($self->can($option)) {
			$self->$option($value)
		} else {
			$self->listbrowser->configure("-$option", $value)
		}
	}
}

sub configSet {
	my ($self, $option) = @_;
	my $cs = $self->{CONFIGSET};
	return exists $cs->{$option};
}

sub crect {
	my $self = shift;
	$self->{CRECT} = shift if @_;
	return $self->{CRECT}
}

sub drawrect {
	my $self = shift;
	$self->{DRAWRECT} = shift if @_;
	return $self->{DRAWRECT}
}

sub font {
	my $self = shift;
	$self->{FONT} = shift if @_;
	return $self->{FONT} if defined $self->{FONT};
	return $self->owner->cget('-font')
}

sub foreground {
	my $self = shift;
	$self->{FOREGROUND} = shift if @_;
	return $self->{FOREGROUND} if defined $self->{FOREGROUND};
	return $self->owner->cget('-foreground')
}

=item B<inregion>I<($x, $y)>

Returns true if the point at I<$x>, I<$y> is inside
the region of this entry.

=cut

sub inregion {
	my ($self, $x, $y) = @_;
	my ($cx, $cy, $cdx, $cdy) = $self->region;
	return '' unless $x >= $cx;
	return '' unless $x <= $cdx;
	return '' unless $y >= $cy;
	return '' unless $y <= $cdy;
	return 1
}

sub ismapped {
	my $self = shift;
	$self->{ISMAPPED} = shift if @_;
	return $self->{ISMAPPED}
}

sub itemtype {
	my $self = shift;
	$self->{ITEMTYPE} = shift if @_;
	return $self->{ITEMTYPE} if defined $self->{ITEMTYPE};
	return $self->owner->cget('-itemtype')
}

sub listbrowser { return $_[0]->{LISTBROWSER} }

=item B<name>

Returns the name of this entry.

=cut

sub name { return $_[0]->{NAME} }

sub owner {
	my $self = shift;
	$self->{OWNER} = shift if @_;
	return $self->{OWNER}
}

sub region {
	my $self = shift;
	$self->{REGION} = [@_] if @_;
	my $r = $self->{REGION};
	return @$r;
}

sub textanchor {
	my $self = shift;
	$self->{TEXTANCHOR} = shift if @_;
	return $self->{TEXTANCHOR} if defined $self->{TEXTANCHOR};
	return $self->owner->cget('-textanchor')
}

sub textjustify {
	my $self = shift;
	$self->{TEXTJUSTIFY} = shift if @_;
	return $self->{TEXTJUSTIFY} if defined $self->{TEXTJUSTIFY};
	return $self->owner->cget('-textjustify')
}

sub textlength {
	my $self = shift;
	$self->{TEXTLENGTH} = shift if @_;
	return $self->{TEXTLENGTH} if defined $self->{TEXTLENGTH};
	return $self->owner->cget('-textlength')
}

sub textside {
	my $self = shift;
	$self->{TEXTSIDE} = shift if @_;
	return $self->{TEXTSIDE} if defined $self->{TEXTSIDE};
	return $self->owner->cget('-textside')
}

sub wraplength {
	my $self = shift;
	if (@_) {
		my $l = shift;
		if ($l > 0) {
			$l = 40 if $l < 40;
		}
		$self->{WRAPLENGTH} = $l;
	}
	return $self->{WRAPLENGTH} if defined $self->{WRAPLENGTH};
	return $self->owner->cget('-wraplength')
}


=back

=head1 LICENSE

Same as Perl.

=head1 AUTHOR

Hans Jeuken (hanje at cpan dot org)

=head1 TODO

=over 4

=back

=head1 BUGS AND CAVEATS

If you find any bugs, please report them here: L<https://github.com/haje61/Tk-ListBrowser/issues>.

=head1 SEE ALSO

=over 4

=back

=cut

1;