—
—
—
—
—
—
—
—
—
—
—
—
—
—
—
—

              
package Tk::ListBrowser::Item;
HideShow 6 lines of Pod
=head1 NAME
Tk::ListBrowser::Item - List entry holding object.
=cut
use strict;
use warnings;
use vars qw ($VERSION);
use Carp;
$VERSION =  0.01;
HideShow 17 lines of Pod
=head1 SYNOPSIS
 my $item = $listbrowser->add($entryname, @options);
 my $item = $listbrowser->get($entryname);
=head1 DESCRIPTION
This module creates an object that holds all information of every entry.
You will never need to create an item object yourself.
=head1 METHODS
=over 4
=cut
sub new {
        my $class = shift;
         
        my %args = @_;
        my $canv = delete $args{'-canvas'};
        croak 'You did not specify a canvas' unless defined $canv;
        my $data = delete $args{'-data'};
        my $hidden = delete $args{'-hidden'};
        $hidden = 0 unless defined $hidden;
        my $image = delete $args{'-image'};
        my $name = delete $args{'-name'};
        croak 'You did not specify an name' unless defined $name;
        my $text = delete $args{'-text'};
        $text = '' unless defined $text;
         
        my $self = {
                ANCHOR => 0,
                CANVAS => $canv,
                COLUMN => undef,
                DATA => $data,
                HIDDEN => $hidden,
                IMAGE => $image,
                NAME => $name,
                REGION => [0, 0, 0, 0],
                ROW => undef,
                SELECTED => 0,
                TEXT => $text,
                TFILL => undef,
        };
        bless $self, $class;
        return $self
}
HideShow 7 lines of Pod
=item B<anchor>I<($flag)>
If I<$flag> is set it makes the anchor rectangle of this entry visible.
Otherwise clears it.
=cut
sub anchor {
        my ($self, $flag) = @_;
        my $c = $self->canvas;
        my $p = $c->Subwidget('Canvas');
        $flag = 1 unless defined $flag;
        my $r = $self->crect;
        $self->{ANCHOR} = $flag;
        if ($flag) {
                my $fg = $c->cget('-foreground');
                $p->itemconfigure($r,
                        -outline => $fg, # TODO should not be a hard coded color.
                        -dash => [3, 2],
                );
        } else {
                my $outline;
                $outline = $c->cget('-selectbackground') if $self->selected;
                $p->itemconfigure($r,
                        -outline => $outline,
                        -dash => undef,
                );
        }
}
HideShow 6 lines of Pod
=item B<anchored>
Returns true if the anchor is set to this entry.
=cut
sub anchored { return $_[0]->{ANCHOR} }
sub canvas { return $_[0]->{CANVAS} }
sub cimage {
        my $self = shift;
        $self->{CIMAGE} = shift if @_;
        return $self->{CIMAGE}
}
HideShow 6 lines of Pod
=item B<clear>I<(?$flag?)>
Clears all visible items (text, image, anchor, selection) on the canvas belonging to this item.
=cut
sub clear {
        my $self = shift;
        my $c = $self->canvas->Subwidget('Canvas');
        for ($self->cimage, $self->ctext, $self->crect) {
                $c->delete($_) if defined $_;
        }
        $self->cimage(undef);
        $self->ctext(undef);
        $self->crect(undef);
        $self->column(undef);
        $self->row(undef);
        $self->region(0, 0, 0, 0);
}
HideShow 6 lines of Pod
=item B<column>I<(?$column?)>
Sets and returns the column number of this entry
=cut
sub column {
        my $self = shift;
        $self->{COLUMN} = shift if @_;
        return $self->{COLUMN}
}
sub crect {
        my $self = shift;
        $self->{CRECT} = shift if @_;
        return $self->{CRECT}
}
sub ctext {
        my $self = shift;
        $self->{CTEXT} = shift if @_;
        return $self->{CTEXT}
}
HideShow 6 lines of Pod
=item B<data>I<(?$data?)>
Sets and returns the data scalar assigned to this entry.
=cut
sub data {
        my $self = shift;
        $self->{DATA} = shift if @_;
        return $self->{DATA}
}
HideShow 6 lines of Pod
=item B<hidden>I<(?$flag?)>
Sets and returns the hidden flag belonging to this entry.
=cut
sub hidden {
        my $self = shift;
        $self->{HIDDEN} = shift if @_;
        return $self->{HIDDEN}
}
HideShow 6 lines of Pod
=item B<image>I<(?$image?)>
Sets and returns the image object belonging to this entry.
=cut
sub image {
        my $self = shift;
        $self->{IMAGE} = shift if @_;
        return $self->{IMAGE}
}
HideShow 7 lines of Pod
=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
}
HideShow 6 lines of Pod
=item B<name>
Sets and returns name of this entry.
=cut
sub name { return $_[0]->{NAME} }
sub region {
        my $self = shift;
        $self->{REGION} = [@_] if @_;
        my $r = $self->{REGION};
        return @$r;
}
HideShow 6 lines of Pod
=item B<row>
Sets and returns the row number of this entry.
=cut
sub row {
        my $self = shift;
        $self->{ROW} = shift if @_;
        return $self->{ROW}
}
HideShow 7 lines of Pod
=item B<select>I<($flag)>
If I<$flag> is set it changes the look of this entry as selected.
Otherwise changes the look to un-selected it.
=cut
sub select {
        my ($self, $flag) = @_;
        $flag = 1 unless defined $flag;
        my $c = $self->canvas;
        my $p = $c->Subwidget('Canvas');
        my $r = $self->crect;
        my $t = $self->ctext;
        $self->{TFILL} = $p->itemcget($t, '-fill') unless defined $self->{TFILL};
        $self->{SELECTED} = $flag;
        if ($flag) {
                $p->itemconfigure($r,
                        -fill => $c->cget('-selectbackground'),
                        -outline => $c->cget('-selectbackground'),
                );
                $p->raise($self->cimage);
                $p->raise($t);
                $p->itemconfigure($t, 
                        -fill => $c->cget('-selectforeground'),
                );
        } else {
                my $outline= $c->cget('-foreground');
                $outline = undef unless $self->anchored;
                $p->itemconfigure($r,
                        -fill => undef,
                        -outline => $outline,
                );
                $p->itemconfigure($t, 
                        -fill => $self->{TFILL},
                );
        }
}
HideShow 6 lines of Pod
=item B<selected>
Returns true if this entry is belonging to the selection.
=cut
sub selected { return $_[0]->{SELECTED} }
HideShow 6 lines of Pod
=item B<text>I<(?$string?)>
Sets and returns the text string belonging to this entry.
=cut
sub text {
        my $self = shift;
        $self->{TEXT} = shift if @_;
        return $self->{TEXT}
}
HideShow 28 lines of Pod
=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