view release on metacpan or  search on metacpan

Widgets/ButtonSet.pm  view on Meta::CPAN

selected button to be rendered in standout mode (inverse video).

=cut

sub _border {
  my $self = shift;
  my $dwh = shift;
  my $conf = $self->{CONF};
  my ($y, $x, $hz, $value, $length, $cols, $lines) = 
    @$conf{qw(Y X HORIZONTAL VALUE LENGTH COLUMNS LINES)};
  my @labels = @{ $$conf{LABELS} };
  my $border = $$conf{BORDER};
  my ($i, $j, $l);

  # Draw the border
  if ($border) {
    if (defined $$conf{BORDERCOL}) {
      $dwh->attrset(COLOR_PAIR(
        select_colour(@$conf{qw(BORDERCOL BACKGROUND)})));
      $dwh->attron(A_BOLD) if $$conf{BORDERCOL} eq 'yellow';
    }
    $dwh->box(ACS_VLINE, ACS_HLINE);
    if ($hz) {
      $i = $length + 1;
      until ($i > $cols) {
        $dwh->addch(0, $i, ACS_TTEE);
        $dwh->addch(1, $i, ACS_VLINE);
        $dwh->addch(2, $i, ACS_BTEE);
        $i += ($length + 1);
      }
    } else {
      $i = 2;
      until ($i > $lines) {
        $dwh->addch($i, 0, ACS_LTEE);
        for ($j = 1; $j <= $length; $j++) {
          $dwh->addch($i, $j, ACS_HLINE) };
        $dwh->addch($i, $length + 1, ACS_RTEE);
        $i += 2;
      }
    }
    $dwh->attroff(A_BOLD);
  }

  $self->_restore($dwh);
}

sub _caption {
  # We won't be needing this method, and I don't want anyone using it by
  # accident.
}

sub _content {
  my $self = shift;
  my $dwh = shift;
  my $conf = $self->{CONF};
  my ($hz, $value, $length)  = @$conf{qw(HORIZONTAL VALUE LENGTH)};
  my @labels = @{$$conf{LABELS}};
  my ($i, $j, $l, $offset);
  my $z = 0;

  # Enforce a sane cursor position
  if ($$conf{VALUE} > $#labels) {
    $$conf{VALUE} = $#labels;
  } elsif ($$conf{VALUE} < 0) {
    $$conf{VALUE} = 0;
  }

  # Calculate the cell offset
  $offset = $$conf{BORDER} ?  1 : ($$conf{PADDING} ? $$conf{PADDING} : 0);

  # Draw the labels
  foreach (@labels) {
    $_ = substr($_, 0, $length);
    if (length($_) < $length - 1) {
      $i = int(($length - length($_)) / 2);
      unless ($$conf{BORDER}) {
        $i--;
        $_ = ' ' x $i . $_ . ' ' x ($length - (length($_) + $i + 2));
        $_ = "<$_>";
        $i = 0;
      }
    }
    if ($hz) {
      $dwh->addstr(0, $z + $i, $_);
      $z += $offset + $length;
    } else {
      $dwh->addstr($z, $i, $_);
      $z += $offset + 1;
    }
  }
}

sub _cursor {
  my $self = shift;
  my $dwh = shift;
  my $conf = $self->{CONF};
  my $label = $$conf{LABELS}->[$$conf{VALUE}];
  my ($length, $hz) = @$conf{qw(LENGTH HORIZONTAL)};
  my ($y, $x) = (0, 0);
  my ($offset);

  # Calculate the cell offset
  $offset = $$conf{BORDER} ?  1 : ($$conf{PADDING} ? $$conf{PADDING} : 0);

  # Set the coordinates
  if ($hz) {
    $offset = $$conf{VALUE} ? $$conf{VALUE} * $length + $$conf{VALUE} * 
      $offset : 0;
    $x = $offset;
  } else {
    $offset = $$conf{VALUE} ? $$conf{VALUE} + $$conf{VALUE} * $offset : 0;
    $y = $offset;
  }
  # Display the cursor
  $dwh->chgat($y, $x, $length, A_STANDOUT, 
    select_colour(@$conf{qw(FOREGROUND BACKGROUND)}), 0);

  # Restore the default settings
  $self->_restore($dwh);
}

sub input_key {
  # Process input a keystroke at a time.
  #
  # Usage:  $self->input_key($key);

  my $self = shift;
  my $in = shift;
  my $conf = $self->{CONF};
  my ($value, $hz) = @$conf{qw(VALUE HORIZONTAL)};
  my $num = scalar @{ $$conf{LABELS} };

  if ($hz) {
    if ($in eq KEY_RIGHT) {
      ++$value;
      $value = 0 if $value == $num;
    } elsif ($in eq KEY_LEFT) {
      --$value;
      $value = ($num - 1) if $value == -1;
    } else {
      beep;
    }
  } else {
    if ($in eq KEY_UP) {
      --$value;
      $value = ($num - 1) if $value == -1;
    } elsif ($in eq KEY_DOWN) {
      ++$value;
      $value = 0 if $value == $num;
    } else {
      beep;
    }
  }

  $$conf{VALUE} = $value;
}

1;

=head1 HISTORY

=over

=item 1999/12/29 -- Original button set widget in functional model

=item 2001/07/05 -- First incarnation in OO architecture

=back

=head1 AUTHOR/COPYRIGHT

(c) 2001 Arthur Corliss (corliss@digitalmages.com)

=cut