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 =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