view release on metacpan or  search on metacpan

Forms.pm  view on Meta::CPAN

sub _relwin {
  my $self = shift;
  my $fwh = $self->{FWH};

  $fwh->delwin if defined $fwh;
  popwh();
  refreshwh();

  $self->{FWH} = undef;
}

sub _geometry {
  my $self = shift;
  my $conf = $self->{CONF};
  my @rv = @$conf{qw(LINES COLUMNS Y X)};

  if ($$conf{BORDER}) {
    $rv[0] += 2;
    $rv[1] += 2;
  }
  @rv[2,3] = (0, 0) if ($self->{LEVEL});

  return @rv;
}

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

  @rv = (@$conf{qw(LINES COLUMNS)}, 0, 0);
  @rv[2,3] = (1, 1) if $$conf{BORDER};

  return @rv;
}

sub _content {
	my $self = shift;
	my $fwh = shift;
	my $active = shift;
  my $conf = $self->{CONF};
  my @taborder = @{$$conf{TABORDER}};
  my $widgets = $self->{WIDGETS};
  my $subforms = $self->{SUBFORMS};
  my $focused = $$conf{FOCUSED} || $taborder[0] || undef;

  # Draw any subforms
  foreach (keys %$subforms) {
    ($active && $_ eq $focused) ? $$subforms{$_}->draw($fwh, 1) : 
      $$subforms{$_}->draw($fwh);
  }

  # Draw the widgets
  foreach (keys %$widgets) {
    ($active && $_ eq $focused) ? $$widgets{$_}->draw($fwh, 1) : 
      $$widgets{$_}->draw($fwh);
  }
}

sub _cursor {
  # Forms don't have cursors, per-se
}

=head2 setField/getField

  $form->setField(BORDER => 1);
  @taborder = @{$form->getField('TABORDER')};

These methods are inherited from the Curses::Widgets module, and hence are
syntactically the same.  For more specifics please see that module.

=head2 addWidget

  $form->addWidget('btnClose', { %options });

This method allows you to add a widget to the form.  Please see the
B<INTRODUCTION> for a more indepth explanation of this call.  Returns a true
if successful, or a false if not (if, for instance, you're trying to use a
widget that module can be found for, or a widget by that name already exists).

=cut

sub addWidget {
  my $self = shift;
  my $name = shift;
  my $options = shift;
  my $type = $$options{TYPE};
  my $widgets = $self->{WIDGETS};
  my $conf = $self->{CONF};
  my @try = ('Curses::Widgets');
  my $alt = $self->{CONF}->{ALTBASE};
  my $success = 0;
  my $base;

  unless ($type) {
    carp ref($self), ":  No widget type specified to add!";
    return 0;
  }

  # Get the alt widget base class, if specified
  if (defined $alt) {
    if (ref($alt) eq 'ARRAY') {
      unshift @try, @$alt;
    } else {
      unshift @try, $self->{CONF}->{ALTBASE};
    }
  }

  # Load the applicable module
  foreach $base (@try) {
    if (eval "require ${base}::$type") {
      $success = 1;
      $type = "${base}::$type";
      last;
    }
  }
  unless ($success) {
    carp ref($self), ":  Loading module $type (in @try) failed!";
    return 0;
  }