package Ddtc::Menu;


use strict;
use Exporter;
use Term::ReadLine;
use Term::ANSIColor;
use Ddtc::Common;

use vars  qw(@ISA);

@ISA	= qw(Exporter);


# new
#
# create new menu with title and redraw
#
# input:
#   title
#   title color
#   default letter color
#   default text color
# output:
#   Menu object
sub new($$;$$$) {
	shift;						# class

	debug 3;
	debug 4, "title: "	 .($_[0] || "")."\n"
		."letter_color: ".($_[0] || "")."\n"
		."text_color:   ".($_[0] || "")."\n"
		."title_color:  ".($_[0] || "")."\n";

	my $self = bless [];

#	$self->[0] = [undef, undef];
	$self -> title	     (	 shift) if @_;
	$self -> letter_color(0, shift);
	$self -> text_color  (0, shift);
	$self -> title_color (	 shift);
	$self -> add("__", sub { 1 });

	return $self;
}


# title
#
# get / set menu title
#
# input:
#   Menu object
#   menu title		[ set ]
# output
#   menu title	
sub title($;$) {
	my $self = shift;

	debug 3;
	debug 4, "title: ".($_[0] || "")."\n";

	$self->[0][2] = shift	if @_;			# set if value provided

	return undef unless defined $self->[0][2];
	debug 4, "title: ".$self->[0][2]."\n";
	$self->[0][2];
}


# letter
#
# get / set letter
#
# input:
#   Menu object
#   item number
#   string			[ set ]
# output
#   letter	
sub letter($$;$){
	my $self = shift;
	my $item = shift;

	debug 3;
	debug 4, "item:   ".$item."\n"
		."string: ".($_[0] || "")."\n";

	if (@_) {					# set if value provided
		$_ = shift;
		/_(.)/;
		$self->[$item][0] = $1 || undef;
	}

	return undef unless exists $self->[$item][0];
	debug 4, "letter: ".$self->[$item][0]."\n";
	$self->[$item][0];
}


# text
#
# get / set text
#
# input:
#   Menu object
#   item number
#   string			[ set ]
# output
#   text
sub text($$;$){
	my $self = shift;
	my $item = shift;

	debug 3;
	debug 4, "item:   ".$item."\n"
		."string: ".($_[0] || "")."\n";

	if (@_) {					# set if value provided
		$_ = shift;
		s/_._//;
		s/_//;
		$self->[$item][1] = $_ || undef;
	}

	return undef unless exists $self->[$item][1];
	debug 4, "text: ".($self->[$item][1] || "")."\n";
	$self->[$item][1];
}


# exec
#
# get / set command
#
# input:
#   Menu object
#   item number
#   code reference			[ set ]
# output
#   code reference
sub exec($$;$){
	my $self = shift;
	my $item = shift;

	debug 3;
	debug 4, "item: ".$item."\n"
		."code: ".($_[0] || "")."\n";

	$self->[$item][2] = shift	if @_;			# set if value provided

	return undef unless exists $self->[$item][2];
	debug 4, "code: ".$self->[$item][2]."\n";
	$self->[$item][2];
}


# letter_color
#
# get / set letter title
#
# input:
#   Menu object
#   item number
#   menu title_color		[ set ]
# output
#   menu title_color	
sub letter_color($$;$){
	my $self = shift;
	my $item = shift || 0;

	debug 3;
	debug 4, "item:  ".$item."\n"
		."color: ".($_[0] || "")."\n";

	$self->[$item][3] = shift	if @_;		# set if value provided

	return 'clear' unless defined $self->[$item][3] || defined $self->[0][3];
	debug 4, "color: ".($self->[$item][3] || $self->[0][3])."\n";
	$self->[$item][3] || $self->[0][3];
}


# text_color
#
# get / set text title
#
# input:
#   Menu object
#   item number
#   menu text_color		[ set ]
# output
#   menu text_color	
sub text_color($$;$){
	my $self = shift;
	my $item = shift || 0;

	debug 3;
	debug 4, "item:  ".$item."\n"
		."color: ".($_[0] || "")."\n";

	$self->[$item][4] = shift	if @_;		# set if value provided

	return 'clear' unless defined $self->[$item][4] || defined $self->[0][4];
	debug 4, "color: ".($self->[$item][4] || $self->[0][4])."\n";
	$self->[$item][4] || $self->[0][4];
}


# title_color
#
# get / set menu title
#
# input:
#   Menu object
#   menu title_color		[ set ]
# output
#   menu title_color	
sub title_color($;$){
	my $self = shift;

	debug 3;
	debug 4, "color: ".($_[0] || "")."\n";

	$self->[0][5] = shift	if @_;			# set if value provided

	return 'clear' unless defined $self->[0][5];
	debug 4, "color: ".$self->[0][5]."\n";
	$self->[0][5];
}


# print
#
# print menu
#
# input:
#   Menu object
sub print($) {
	my $self = shift;

	debug 3;

	debug 0, "\n  "
		.color($self -> title_color)
		.     ($self -> title      )
		.color('clear'             )."\n";
	for (my $i = 0; $i < @{ $self }; $i++) {
		next unless defined $self -> text($i);
		debug 0, color($self -> letter_color($i))
			.     ($self -> letter      ($i))
			.color('clear'			)
			.color($self -> text_color  ($i))." "
			.     ($self -> text        ($i))
			.color('clear'			)."\n";
	}
}


# add
#
# add item to menu
#
# input:
#   Menu object
#   string
#   sub reference
sub add($$$;$$) {
	my $self   = shift;
	my $string = shift;
	my $sub    = shift;

	my $i = @{ $self };

	debug 3;
	debug 4, "item:  ".$i."\n"
		."string: ".$string."\n"
		."code:   ".$sub."\n";

	$self -> letter	     ($i, $string);
	$self -> text	     ($i, $string);
	$self -> exec	     ($i, $sub);
	$self -> letter_color($i, shift) if @_;
	$self -> text_color  ($i, shift) if @_;

	return $self;
}


# execute
#
# execute menu
#
# input:
#   reference of menu hash
#   terminal object
sub execute($$) {
	my $self = shift;
	my $term = shift;

	debug 3;

	$self -> print;

	my $letters = "";
	for (my $i = 0; $i < @{ $self }; $i++) {
		next unless defined $self -> letter($i);
		$letters .= $self -> letter($i);
	}
	my $prompt  =  $letters;
	   $prompt  =~ s/\W//g;

	while(1) {
		my $l;
		until ($l && ($l =~ /^[$letters]?$/)) {
			$l   = $term -> readline("$prompt\: ");
			defined $l ? chomp $l : print "\n";
		}
		for (my $i = 0; $i < @{ $self }; $i++) {
			next unless $self -> letter($i);
			next unless $l eq $self -> letter($i);
			return &{ $self -> exec($i) };
		}
	}
}

1;