The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

=head1 NAME
Tk::ListBrowser - Tk::ListBrowser::Row - Row organizer for Tk::ListBrowser.
=head1 SYNOPSIS
require Tk::ListBrowser;
my $ib= $window->ListBrowser(@options,
-arrange => 'row'
)->pack;
$ib->add('item_1', -image => $image1, -text => $text1);
$ib->add('item_2', -image => $image2, -text => $text2);
$ib->refresh;
=head1 DESCRIPTION
Contains all the drawing routines for L<Tk::ListBrowser> to
draw and navigate the list in a row organized manner.
No user serviceable parts inside.
=cut
use strict;
use vars qw($VERSION $AUTOLOAD);
$VERSION = 0.01;
use Carp;
sub new {
my ($class, $lb) = @_;
carp 'You did not specify a list browser' unless defined $lb;
my $self = {
CELLHEIGHT => 0,
CELLWIDTH => 0,
IMAGEHEIGHT => 0,
IMAGEWIDTH => 0,
TEXTHEIGHT => 0,
TEXTWIDTH => 0,
LISTBROWSER => $lb,
};
bless $self, $class;
return $self
}
sub AUTOLOAD {
my $self = shift;
return if $AUTOLOAD =~ /::DESTROY$/;
$AUTOLOAD =~ s/^.*:://;
return $self->{LISTBROWSER}->$AUTOLOAD(@_);
}
sub cellHeight {
my $self = shift;
$self->{CELLHEIGHT} = shift if @_;
return $self->{CELLHEIGHT}
}
sub cellImageHeight {
my $self = shift;
$self->{IMAGEHEIGHT} = shift if @_;
return $self->{IMAGEHEIGHT}
}
sub cellImageWidth {
my $self = shift;
$self->{IMAGEWIDTH} = shift if @_;
return $self->{IMAGEWIDTH}
}
sub cellSize {
my $self = shift;
my $pool = $self->pool;
my $imageheight = 0;
my $imagewidth = 0;
my $textwidth = 0;
my $textheight = $self->fontMetrics($self->cget('-font'), '-descent');
0;
for (@$pool) {
my $image = $_->image;
if (defined $image) {
my $ih = $image->height;
$imageheight = $ih if $ih > $imageheight;
my $iw = $image->width;
$imagewidth = $iw if $iw > $imagewidth;
}
my $text = $_->text;
if (defined $text) {
$text = $self->textFormat($_->text);
my $th = $self->textHeight($text);
$textheight = $th if $th > $textheight;
my $tw = $self->textWidth($text);
$textwidth = $tw if $tw > $textwidth;
}
}
my $itemtype = $self->cget('-itemtype');
my $pad = 6;
$pad = 4 if $itemtype ne 'imagetext';
$imageheight = $imageheight + $pad;
$imagewidth = $imagewidth + $pad;
$textheight = $textheight + $pad;
$textwidth = $textwidth + $pad;
my $cellheight;
my $cellwidth;
my $textside = $self->cget('-textside');
if ($itemtype eq 'image') {
$cellheight = $imageheight + $pad;
$cellwidth = $imagewidth + $pad;
} elsif ($itemtype eq 'text') {
$cellheight = $textheight + $pad;
$cellwidth = $textwidth + $pad;
} else {
if (($textside eq 'top') or ($textside eq 'bottom')) {
$cellheight = $imageheight + $textheight + $pad;
$cellwidth = $imagewidth;
$cellwidth = $textwidth if $textwidth > $cellwidth;
$cellwidth = $cellwidth + $pad - 2;
} elsif (($textside eq 'left') or ($textside eq 'right')) {
$cellheight = $imageheight;
$cellheight = $textheight if $textheight > $cellheight;
$cellheight = $cellheight + $pad - 2;
$cellwidth = $imagewidth + $textwidth + $pad;
}
}
$self->cellHeight($cellheight);
$self->cellImageHeight($imageheight);
$self->cellImageWidth($imagewidth);
$self->cellTextHeight($textheight);
$self->cellTextWidth($textwidth);
$self->cellWidth($cellwidth);
return ($cellwidth, $cellheight)
}
sub cellTextHeight {
my $self = shift;
$self->{TEXTHEIGHT} = shift if @_;
return $self->{TEXTHEIGHT}
}
sub cellTextWidth {
my $self = shift;
$self->{TEXTWIDTH} = shift if @_;
return $self->{TEXTWIDTH}
}
sub cellWidth {
my $self = shift;
$self->{CELLWIDTH} = shift if @_;
return $self->{CELLWIDTH}
}
sub maxXY {
my $self = shift;
my $maxc = 0;
my $maxr = 0;
my $pool = $self->pool;
for (@$pool) {
my $c = $_->column;
$maxc = $c if ((defined $c) and ($c > $maxc));
my $r = $_->row;
$maxr = $r if ((defined $r) and ($r > $maxr));
}
my $maxx = ($maxc + 1) * ($self->cellWidth + 1);
my $maxy = ($maxr + 1) * ($self->cellHeight + 1);
return ($maxx, $maxy);
}
sub nextPosition {
my ($self, $x, $y, $column, $row) = @_;
my $cellheight = $self->cellHeight;
my $cellwidth = $self->cellWidth;
my $newx = $x + ($cellwidth * 2);
my ($cwidth, $cheight) = $self->canvasSize;
if ($newx >= $cwidth) {
$x = 0;
$y = $y + $cellheight + 1;
$column = 0;
$row ++;
} else {
$x = $x + $cellwidth + 1;
$column ++;
}
return ($x, $y, $column, $row)
}
sub refresh {
my $self = shift;
my $pool = $self->pool;
$self->clear;
my ($cellwidth, $cellheight) = $self->cellSize;
my $x = 0;
my $y = 0;
my $ioffsetx = 0;
my $maxx = 0;
my $maxy = 0;
my $column = 0;
my $row = 0;
my $fontdescent = $self->fontMetrics($self->cget('-font'), '-descent');
for (@$pool) {
my $item = $_;
next if $item->hidden;
my $image = $item->image;
my $ih = 0;
my $iw = 0;
if (defined $image) {
$ih = $image->height;
$iw = $image->width;
}
my $text = $item->text;
my $th = 0;
my $tw = 0;
if (defined $text) {
$text = $self->textFormat($item->text);
$th = $self->textHeight($text);
$tw = $self->textWidth($text);
}
my $imageoffsetx = 0;
my $imageoffsety = 0;
my $textoffsetx = 0;
my $textoffsety = 0;
my @textcavity = (0, 0, 0, 0);
my $imageheight = $self->cellImageHeight;
my $imagewidth = $self->cellImageWidth;
my $textheight = $self->cellTextHeight;
my $textwidth = $self->cellTextWidth;
my $itemtype = $self->cget('-itemtype');
if ($itemtype eq 'image') {
$imageoffsetx = int(($cellwidth - $iw)/2);
$imageoffsety = int(($cellheight - $ih)/2);
} elsif ($itemtype eq 'text') {
@textcavity = (0 ,0, $cellwidth, $cellheight)
} else {
my $imageheight = $self->cellImageHeight;
my $imagewidth = $self->cellImageWidth;
my $textheight = $self->cellTextHeight;
my $textwidth = $self->cellTextWidth;
my $textside = $self->cget('-textside');
if ($textside eq 'top') {
@textcavity = (0, 0, $cellwidth, $textheight);
$imageoffsety = $textheight + int(($imageheight - $ih)/2);
$imageoffsetx = $imageoffsetx + int(($cellwidth - $iw)/2);
} elsif ($textside eq 'bottom') {
@textcavity = (0, $imageheight, $cellwidth, $cellheight);
$imageoffsetx = $imageoffsetx + int(($cellwidth - $iw)/2);
$imageoffsety = $imageoffsety + int(($imageheight - $ih)/2);
} elsif ($textside eq 'left') {
@textcavity = (0, 0, $textwidth, $cellheight);
$imageoffsety = $imageoffsety + int(($cellheight - $ih)/2);
$imageoffsetx = $textwidth;
} elsif ($textside eq 'right') {
@textcavity = ($imagewidth, 0, $cellwidth, $cellheight);
$imageoffsety = $imageoffsety + int(($cellheight - $ih)/2);
}
}
my $centerx = $textcavity[0] + int(($textcavity[2] - $textcavity[0] - $tw)/2);
my $centery = $textcavity[1] + int(($textcavity[3] - $textcavity[1] - $th)/2);
my $textanchor = $self->cget('-textanchor');
if ($textanchor eq '') {
$textoffsetx = $centerx;
$textoffsety = $centery;
} elsif ($textanchor eq 's') {
$textoffsetx = $centerx;
$textoffsety = $textcavity[3] - $th;
} elsif ($textanchor eq 'e') {
$textoffsetx = $textcavity[2] - $tw;
$textoffsety = $centery;
} elsif ($textanchor eq 'n') {
$textoffsetx = $centerx;
$textoffsety = $textcavity[1];
} elsif ($textanchor eq 'w') {
$textoffsetx = $textcavity[0];
$textoffsety = $centery;
} elsif ($textanchor eq 'se') {
$textoffsetx = $textcavity[2] - $tw;
$textoffsety = $textcavity[3] - $th;
} elsif ($textanchor eq 'sw') {
$textoffsetx = $textcavity[0];
$textoffsety = $textcavity[3] - $th;
} elsif ($textanchor eq 'ne') {
$textoffsetx = $textcavity[2] - $tw;
$textoffsety = $textcavity[1];
} elsif ($textanchor eq 'nw') {
$textoffsetx = $textcavity[0];
$textoffsety = $textcavity[1];
}
if ($itemtype =~ /image/) {
my $itag;
$itag = $self->createImage($x + $imageoffsetx, $y + $imageoffsety,
-image => $image,
-anchor => 'nw',
) if defined $image;
$item->cimage($itag);
}
if ($itemtype =~ /text/) {
my $ttag;
$ttag = $self->createText($x + $textoffsetx, $y + $textoffsety,
-text => $text,
-justify => $self->cget('-textjustify'),
-anchor => 'nw',
-font => $self->cget(-font),
) if defined $text;
$item->ctext($ttag);
}
my $dx = $x + $cellwidth;
my $dy = $y + $cellheight;
my $rtag = $self->createRectangle($x, $y, $dx, $dy,
-fill => undef,
-outline => undef,
);
$item->crect($rtag);
$item->region($x, $y, $dx, $dy);
$item->column($column);
$item->row($row);
my ($cwidth, $cheight) = $self->canvasSize;
($x, $y, $column, $row) = $self->nextPosition($x, $y, $column, $row);
$maxx = $x if $x > $maxx;
$maxy = $y if $y > $maxy;
}
$self->configure(-scrollregion => [0, 0, $self->maxXY]);
# $self->configure(-scrollregion => [0, 0, $maxx + $cellwidth + 2, $maxy + $cellheight + 2]);
}
sub scroll {
return 'vertical'
}
sub type {
return 'row'
}
=head1 LICENSE
Same as Perl.
=head1 AUTHOR
Hans Jeuken (hanje at cpan dot org)
=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
=item L<Tk::ListBrowser>
=item L<Tk::ListBrowser::Bar>
=item L<Tk::ListBrowser::Column>
=item L<Tk::ListBrowser::Item>
=item L<Tk::ListBrowser::List>
=back
=cut
1;