view release on metacpan or  search on metacpan

Widgets/ListBox/MultiColumn.pm  view on Meta::CPAN

  ============================================================
  COLUMNS            []   Column widths
  LISTITEMS          []   List of list values
  HEADERS            []   Column header labels
  HEADERFGCOL     undef   Header foreground colour
  HEADERBGCOL     undef   Header background colour
  BIGHEADER           0   Use more graphics for the header
  KEYINDX             0   Index of key column

If headers are defined but one or both of the header colours are not, then
they will default to the widget fore and background.

B<NOTE>:  Headers take up more lines in addition to the border (one line for
the normal, small header, two lines for the larger).  You need to take that
into account when setting the geometry.  If no labels are passed in the
HEADERS array, no space will be used for the headers.

The B<KEYINDX> value is currently only used to match keystrokes against for
quick navigation.

=cut

sub _conf {
  # Validates and initialises the new ListBox object.
  #
  # Usage:  $self->_conf(%conf);

  my $self = shift;
  my %conf = (
    COLWIDTHS   => [10],
    KEYINDEX    => 0,
    HEADERS     => [],
    BIGHEADER   => 0,
    KEYINDX     => 0,
    @_
    );
  my $err = 0;
  my @required = qw(COLWIDTHS);

  # Check for required fields
  foreach (@required) { $err = 1 unless exists $conf{$_} };
  $err = 1 unless @{$conf{COLWIDTHS}};

  # Lowercase extra colours
  foreach (qw(HEADERFGCOL HEADERBGCOL)) { 
    $conf{$_} = lc($conf{$_}) if exists $conf{$_} };

  # Make sure no errors are returned by the parent method
  $err = 1 unless $self->SUPER::_conf(%conf);

  return $err == 0 ? 1 : 0;
}

=head2 draw

  $lb->draw($mwh, 1);

The draw method renders the list box in its current state.  This
requires a valid handle to a curses window in which it will render
itself.  The optional second argument, if true, will cause the field's
text cursor to be rendered as well.

=cut

sub _geometry {
  my $self = shift;
  my $conf = $self->{CONF};
  my @rv;

  @rv = $self->SUPER::_geometry;
  if (@{$$conf{HEADERS}}) {
    $rv[0]++;
    $rv[0]++ if $$conf{BIGHEADER};
  }

  return @rv;
}

sub _cgeometry {
  my $self = shift;
  my $conf = $self->{CONF};
  my @rv;

  @rv = $self->SUPER::_cgeometry;
  if (@{$$conf{HEADERS}}) {
    $rv[2]++;
    $rv[2]++ if $$conf{BIGHEADER};
  }

  return @rv;
}

sub _border {
  my $self = shift;
  my $dwh = shift;
  my $conf = $self->{CONF};
  my (@colours, $header, @headers, $i, $h);
  my ($y, $x);

  # Render the border
  $self->SUPER::_border($dwh);

  # Draw the headers if any were defined
  if (@{$$conf{HEADERS}}) {

    # Construct the header
    $i = -1;
    foreach (@{$$conf{COLWIDTHS}}) {
      ++$i;
      next unless $_;
      $h = $$conf{HEADERS}[$i] || '';
      $header .= substr($h, 0, $_);
      $header .= ' ' x ($_ - length($h)) if length($h) < $_;
      $header .= ' ';
    }
    chop $header;

    # Print the header
    $i = $$conf{BORDER} ? 1 : 0;
    $dwh->addstr($i, $i, substr($header, 0, $$conf{COLUMNS}));