package Lire::UI::Utils;
use strict;
use base qw/ Exporter /;
use Carp;
use Lire::Utils qw/ check_param check_object_param /;
use vars qw( @EXPORT_OK );
BEGIN {
@EXPORT_OK = qw/ button_box_width button_label layout_buttonbox /;
}
=pod
=head1 NAME
Lire::UI::Utils - Utility functions for UI management
=head1 SYNOPSIS
use Lire::UI::Utils;
=head1 DESCRIPTION
Utility functions for UI code.
=head2 button_box_width( $buttons )
Computes the width required to draw the button box described by the 'buttons'
parameter. This parameter is a hash reference.
=cut
sub button_box_width {
my $buttons = $_[0];
check_object_param( $buttons, 'buttons', 'ARRAY' );
my $width = scalar ( @$buttons ) - 1;
foreach my $button ( @$buttons ) {
$width += length( $button->{'-label'} );
}
return $width;
}
=pod
=head2 button_label( $label, $max_button_width )
Returns a label suitable for a button considering that the maximum
width of the button is $max_button_width.
=cut
sub button_label {
my ( $label, $max_width ) = @_;
check_param( $label, 'label' );
return '[' . $label . ']'
if ! $max_width || (length( $label) + 2) <= $max_width;
$max_width = 4 if $max_width < 4;
return '[' . substr( $label, 0, $max_width-3) . '.]';
}
=pod
=head2 layout_buttonbox( $container, $box, [ $padleft ], [ $padright ] )
Crops the labels of the Curses::UI::Buttonbox $box until it fits in
the canvaswidth() of the $container. $padleft and $padright can be
used to allow space for padding. The function will set the '-width'
and '-x' attributes of the Buttonbox. In the worst case, the label
will be reduced to their first letter. The Buttonbox's buttons should
have their '-label' attribute set to the full label without any button
decorations (like '['), these will be added by the function after
cropping.
=cut
sub layout_buttonbox {
my ( $container, $box, $padleft, $padright ) = @_;
check_object_param( $container, 'container', 'Curses::UI::Container' );
check_object_param( $box, 'buttonbox', 'Curses::UI::Buttonbox' );
$padleft ||= 0;
$padright ||= 0;
my $avail = $container->canvaswidth() - $padleft - $padright;
# [] are added after the fact.
my $n = @{$box->{'-buttons'}};
my $decorations = $n * 2;
# We can reduce buttons to [X]
my $min = $n * 3 + ( $n - 1 );
my $needed = button_box_width( $box->{'-buttons'} ) + $decorations;
if ( $min <= $avail ) {
while ( $needed > $avail ) {
# Crop largest label
my $max = max_label_idx( $box );
my $label = $box->{'-buttons'}[$max]{'-label'};
my $label_len = length $label;
last if $label_len == 1; # All labels are at 1 char.
if ( length $label == 2 ) {
$label = substr( $label, 0, 1 );
} else {
$label = substr( $label, 0, $label_len - 2 ) . '.';
}
$box->{'-buttons'}[$max]{'-label'} = $label;
$needed = button_box_width( $box->{'-buttons'} ) + $decorations;
}
} # Otherwise don't bother
$box->{'-width'} = $needed;
$box->{'-x'} = $padleft;
# Add decorations
foreach my $btn ( @{$box->{'-buttons'}} ) {
$btn->{'-label'} = '[' . $btn->{'-label'} . ']';
}
return;
}
sub max_label_idx {
my $box = $_[0];
my $max_idx;
my $max_len = 0;
foreach ( my $i=0; $i < @{$box->{'-buttons'}}; $i++ ) {
my $len = length $box->{'-buttons'}[$i]{'-label'};
if ( $len > $max_len ) {
$max_len = $len;
$max_idx = $i;
}
}
return $max_idx;
}
1;
__END__
=pod
=head1 SEE ALSO
Lire::UI(3pm)
=head1 VERSION
$Id: Utils.pm,v 1.7 2006/07/23 13:16:32 vanbaal Exp $
=head1 AUTHORS
Wolfgang Sourdeau <wolfgang@logreport.org>
=head1 COPYRIGHT
Copyright (C) 2004 Stichting LogReport Foundation LogReport@LogReport.org
This file is part of Lire.
Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html.
=cut
syntax highlighted by Code2HTML, v. 0.9.1