# $Id: Dialog.pm,v 1.1 2000/06/06 07:05:36 mike_s Exp $

package Dialog;

use strict;
use Carp qw(croak);
use vars qw($VERSION @ISA @EXPORT $AUTOLOAD);
use Dialog::TInputLine;
use Dialog::TButton;
use Dialog::TLabel;
use Dialog::Const;

require Exporter;
require DynaLoader;
require AutoLoader;

@ISA = qw(Exporter DynaLoader Dialog::Const);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	ATTRIBUTE_COUNT
	FALSE
	HAVE_NCURSES
	MAX_LEN
	TRUE
	VERSION
	border_attr
	button_active_attr
	button_inactive_attr
	button_key_active_attr
	button_key_inactive_attr
	button_label_active_attr
	button_label_inactive_attr
	check_attr
	check_selected_attr
	darrow_attr
	dialog_attr
	inputbox_attr
	inputbox_border_attr
	item_attr
	item_selected_attr
	menubox_attr
	menubox_border_attr
	position_indicator_attr
	screen_attr
	searchbox_attr
	searchbox_border_attr
	searchbox_title_attr
	shadow_attr
	tag_attr
	tag_key_attr
	tag_key_selected_attr
	tag_selected_attr
	title_attr
	uarrow_attr
);
$VERSION = '0.03';

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.

    my $constname;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	if ($! =~ /Invalid/) {
	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
		Carp::confess "Your vendor has not defined Dialog macro $constname";
	}
    }
    eval "sub $AUTOLOAD { $val }";
    goto &$AUTOLOAD;
}

bootstrap Dialog $VERSION;

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

no strict "vars";
no strict "subs";

sub new {
  %objlist = {};
  @objlist = ();
  $current = 0;

  ($self, $title, $y, $x, $height, $width) = @_;
  $self = bless {};
  Init() unless $instances++;
  Clear();
  draw();
  $self;
}

sub DESTROY {
  Exit() unless --$instances;
}

sub draw {
  draw_box($y, $x, $height, $width, dialog_attr, border_attr);
  draw_shadow($y, $x, $height, $width);
  return unless $title;
  attrset(title_attr);
  mvprintw($y, $x+($width-length($title)-1)/2, " $title ");
}

sub run {
  $self = shift;

  my $key;
  $modalresult = 0;
  while(! $modalresult) {
    Update();
    $key = $objlist{$objlist[$current]}->exec();
    Update();
    if($key == KEY_TAB or $key == KEY_DOWN or $key == KEY_RIGHT) { tab() }
    elsif($key == KEY_UP or $key == KEY_BTAB or $key == KEY_LEFT) { s_tab() }
    elsif($key == KEY_ESC) { $modalresult = mrCancel }
    else { dispatch($key) }
  }
  $modalresult;
}

sub s_tab {
  my $old = $current;
  while() {
    $current = $current ? $current-1 : $#objlist;
    return if $current == $old or $objlist{$objlist[$current]}->tabstop;
  }
}

sub tab {
  my $old = $current;
  while() {
    $current = $current < $#objlist ? $current+1 : 0;
    return if $current == $old or $objlist{$objlist[$current]}->tabstop;
  }
}

sub dispatch {
  $objlist{$objlist[$current]}->onkey(shift);
}

sub current {
  my($self, $name) = @_;
  return $objlist{$objlist[$current]} unless defined $name;
  $name = $name->name if ref($name);
  Carp::carp "No such object: $name" unless defined $objlist{$name};
  for($current = 0; $current <= $#objlist; $current++) {
    last if $objlist[$current] eq $name;
  }
  redraw();
}

sub endmodal {
  my($self, $mr) = @_;
  return $modalresult unless defined $mr;
  $modalresult = $mr;
}

sub object {
  my($self, $name) = @_;
  $objlist{$name};
}

sub redraw {
  draw();
  foreach(@objlist) { $objlist{$_}->draw };
  refresh();
}

sub inputline {
  my($self, $_name, $_y, $_x, $_w, $_s) = @_;
  Carp::carp "Inputline \"$_name\" already defined" if $objlist{$_name};
  $objlist{$_name} = TInputLine->new($self, $_name, $_y+$y, $_x+$x, $_w, $_s);
  push @objlist, $_name;
  $objlist{$_name};
}

sub button {
  my($self, $_name, $_y, $_x, $_s, $_res) = @_;
  Carp::carp "Inputline \"$_name\" already defined" if $objlist{$_name};
  $objlist{$_name} = TButton->new($self, $_name, $_y+$y, $_x+$x, $_s, $_res);
  push @objlist, $_name;
  $objlist{$_name};
}

sub label {
  my($self, $_name, $_y, $_x, $_s) = @_;
  Carp::carp "Inputline \"$_name\" already defined" if $objlist{$_name};
  $objlist{$_name} = TLabel->new($self, $_name, $_y+$y, $_x+$x, $_s);
  push @objlist, $_name;
  $objlist{$_name};
}

1;
__END__


syntax highlighted by Code2HTML, v. 0.9.1