lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / UI / Utils.pm

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