#!/usr/bin/perl -w
use strict;
use lib $ENV{ 'MAIN_CONF'}  ;
use main_config ;
use Tk;

my %commands = () ;

if ( @ARGV <= 0 ) { push ( @{$commands{'help'}}, ' ' ) ; } 
else { (%commands) = main_config::get_commands ( @ARGV ) ; }


my $PROC_ERROR = "FALSE" ;
my $MACRO_FILE ="" ;

my $keyword ; 
foreach $keyword ( sort keys (%commands) ) 
{
    if ( $keyword eq 'h' || substr($keyword, 0,4) eq "help" ) { goto HELP }
    if ( $keyword eq 'm' || substr($keyword, 0,5) eq "macro" ) { goto MACRO }
    print "unknown option >$keyword<\n" ; $PROC_ERROR = "TRUE" ;

  HELP:
    print << "END_OF_TEXT" ;
    -h|-help|--help) prints this message with available options and current status 
    -m|--macro)     file name of the created macro [$MACRO_FILE]
END_OF_TEXT
    exit ;
 MACRO: 
    $MACRO_FILE = shift ( @{$commands{$keyword}} ) ; 
next ;
}
if ( $PROC_ERROR eq "TRUE" ) { exit ; }
#######################################

my $line ;
my @whole_file = () ;
my %key_list = () ;
my $key ;

#my $MACRO_FILE = "create_refine.pl" ;


open ( MACRO, "$MACRO_FILE |" ) ;
while(<MACRO>)
{
    chomp ;
    my $line = $_ ;
    push( @whole_file, $line ) ;
}
close(MACRO) ;

$key = "" ;
    my $n_bra = 0 ;
    my @a_key = () ;
    my @b_key = () ;
    my @a_word = () ; my @b_word = () ; my @c_word = () ;
    my @text = () ;
    my $xx ;
    my $val ;
    my $chr ;
my $nchr = 0 ; 

foreach $line ( @whole_file ) 
{
#    print $line, "\n" ;
    my @chr_array = split( '', $line ) ;
    
    @a_key = () ;
    $n_bra = 0 ;
    $nchr = 0 ; 
    foreach $chr (@chr_array) 
    {
	if ( $chr eq "\)" ) { $n_bra = $nchr } #
	elsif ( $n_bra == 0 ) { push( @a_key, $chr ) ; }
	else { push (@b_key, $chr ) ; } 
	$nchr++ ;
    }

    if ( $nchr > 0 )
    {
	if ( $n_bra > 0 ) 
	{ 
	    if ( $key ne "" && lc($key) ne "help" && lc($key) ne "doit" ) 
	    {
		gen_entry ( @text ) ;
	    }
	    $xx = join ( '', @a_key) ;
	    @text = split( "-", $xx ) ;
	    $key = pop( @text ) ;
	    my $xx = join( '', @b_key ) ;
	    @text = ( $xx ) ;
	    @b_key = () ;
#	    @{$key_list{$key}{'LINE'}} = ( $xx );
	}
	else
	{
	    $xx = join( '', @a_key ) ;
#	    push( @{$key_list{$key}{'LINE'}}, "\n" ) ;
#	    push( @{$key_list{$key}{'LINE'}}, $xx ) ;
	    push ( @text, $xx ) ;
#	    print " new line:", $xx, "\n" ;
	}
    }

#    print " TABLE: key >", $key, "< LINE: >", @{$key_list{$key}{'LINE'}}, "<\n" ;
#    print " TABLE: key >", $key, "< LINE: >", $key_list{$key}{'LINE'}, "<\n" ;
#    $key = "" ;
}
if ( $key ne "" && lc($key) ne "help" && lc($key) ne "doit" ) 
{
    gen_entry ( @text ) ;
}
my $max_length = 0 ;
foreach $key ( sort keys %key_list )
{
#    print " TABLE: key >", $key, " LN:>", $key_list{$key}{'LINE'}, "<\n" ;
    if ( length($key_list{$key}{'LINE'}) > $max_length ) 
    { $max_length = length($key_list{$key}{'LINE'}) ; }
}
######################################################

my $mw = MainWindow->new;
$mw->title("Tk: $MACRO_FILE");
my $f = $mw->Frame->pack(-side => 'bottom');
$f->Button(-text => "Quit", 
           -command => sub { exit; })->pack(-side => 'left');
$f->Button(-text => "doit",
           -command => \&create_macro )->pack(-side => 'bottom');
my $t = $mw->Scrolled("Text", -width => $max_length + 30, 
                   -wrap => 'none')->pack(-expand => 10, -fill => 'both');

my $w ;
my $text ;

foreach $key ( keys %key_list )
{
#	$w = $t->Entry(-width => 12, -textvariable => \$key_list{$key}{'LINE'});
    if ( $key_list{$key}{'KIND'} eq "VALUE" )
    {
	$text = $key_list{$key}{'LINE'} ;
	$val = $key_list{$key}{'VALUE'} ;
	$w = $t->Label(-text => "$text", -justify => 'left', -relief => 'groove', 
		      -width => $max_length );
	$t->windowCreate('end', -window => $w);
	$w = $t->Entry(-width => 12, -textvariable => \$key_list{$key}{'VALUE'} );
	$t->windowCreate('end', -window => $w);
	$t->insert('end', "\n");
    }
    elsif ( $key_list{$key}{'KIND'} eq "PAIR" )
    {
	$text = $key_list{$key}{'LINE'} ;
	$val = $key_list{$key}{'VALUE'} ;
	$w = $t->Label(-text => "$text", -justify => 'left', -relief => 'groove', 
		      -width => $max_length );
	$t->windowCreate('end', -window => $w);
	$w = $t->Entry(-width => 12, -textvariable => \$key_list{$key}{'ARRAY'}[0] );
	$t->windowCreate('end', -window => $w);
	$w = $t->Entry(-width => 12, -textvariable => \$key_list{$key}{'ARRAY'}[1] );
	$t->windowCreate('end', -window => $w);
	$t->insert('end', "\n");
    }
    elsif ( $key_list{$key}{'KIND'} eq "THREES" )
    {
	$text = $key_list{$key}{'LINE'} ;
	$val = $key_list{$key}{'VALUE'} ;
	$w = $t->Label(-text => "$text", -justify => 'left', -relief => 'groove', 
		      -width => $max_length );
	$t->windowCreate('end', -window => $w);
	$w = $t->Entry(-width => 12, -textvariable => \$key_list{$key}{'ARRAY'}[0] );
	$t->windowCreate('end', -window => $w);
	$w = $t->Entry(-width => 12, -textvariable => \$key_list{$key}{'ARRAY'}[1] );
	$t->windowCreate('end', -window => $w);
	$w = $t->Entry(-width => 12, -textvariable => \$key_list{$key}{'ARRAY'}[2] );
	$t->windowCreate('end', -window => $w);
	$t->insert('end', "\n");
    }
    elsif ( $key_list{$key}{'KIND'} eq "LIST" )
    {
	$text = $key_list{$key}{'LINE'} ;
	$w = $t->Label(-text => "$text", -justify => 'left', -relief => 'groove', 
		      -width => $max_length );
	$t->windowCreate('end', -window => $w);
	$w = $t->Optionmenu(-width => 7, 
			    -textvariable => \$key_list{$key}{'VALUE'}, 
			    -options => [@{$key_list{$key}{'LIST'}} ]
	    );
	$t->windowCreate('end', -window => $w);
	$t->insert('end', "\n");
    }

}
$t->configure(-state => 'disabled');
MainLoop;


sub gen_entry
{
    my @text_line = @_ ;
    my $n_brk = 0 ;
    my $nin = 0 ; 
    my $xx ;
    my $chr ;

    @a_word = () ; @b_word = () ; @c_word = () ;
    $xx = join( " ", @text_line ) ;
    @text_line = split ( "", $xx ) ;
    foreach $chr (@text_line) 
    {
	if ( $chr eq "\[" ) { $nin=1 } #
	elsif ( $chr eq "\]" ) 
	{ 
	    $xx = join ( "", @a_word ) ;
	    push ( @c_word, $xx ) ;
	    $n_brk++; $nin=0 ; @a_word = () ;
	} #
	elsif ( $nin == 0 ) 
	{
	    push( @b_word, $chr ) ;
	}
	else
	{
	    push( @a_word, $chr ) ;
	}
    }
#    print " -- a_word:", @a_word, "\n" ;
#    print " -- b_word:", @b_word, "\n" ;
#    print " -- c_word:", @c_word, "\n" ;
    my $kind = "" ;
    $xx = join ("", @b_word ) ;
    $xx =~ s/current// ; $xx =~ s/=// ; $xx =~ s/:// ; 
    my @chrs = split ( " ", $xx ) ;

    $val = pop (@c_word ) ;

    my @items = split( " - ", $val ) ;
    my $nn = scalar ( @items ) ;
    if ( $nn == 2 ) { $kind = "PAIR" ; }
    @items = split( ", ", $val ) ;
    $nn = scalar ( @items ) ;
    if ( $nn == 3 ) { $kind = "THREES" ; }

#    print " nn:", $nn, " items:", @items, "\n" ;

    if ( $kind eq "PAIR" ) 
    {
	@items = split( " - ", $val ) ;
	$xx = join (" ", @chrs ) ;
	if ( scalar ( @c_word >= 1 ) ) { $xx = join ("", $xx, " [" , @c_word , "] " ) ; }
#	$xx = $xx . "[" . @c_word . "]" ;
	$key_list{$key}{'LINE'} = $xx ; 
	$key_list{$key}{"KIND"} = "PAIR" ;
	@{$key_list{$key}{'ARRAY'}} = @items ;
#	print "items:", @items , "\n" ;
#	print "--------------> ", $key, " ARRAYS MENU:", $nn, ':>', @{$key_list{$key}{'ARRAY'}}, "<\n" ;
    }
    elsif ( $kind eq "THREES" ) 
    {
	@items = split( ", ", $val ) ;
	$xx = join (" ", @chrs ) ;
#	$xx = $xx . "[" . @c_word . "]" ;
	$key_list{$key}{'LINE'} = $xx ; 
	$key_list{$key}{"KIND"} = "THREES" ;
	@{$key_list{$key}{'ARRAY'}} = @items ;
#	print "items:", @items , "\n" ;
#	print "--------------> ", $key, " ARRAYS MENU:", $nn, ':>', @{$key_list{$key}{'ARRAY'}}, "<\n" ;
    }
    else
    {

	$key_list{$key}{'VALUE'} = $val ;
	
	$xx = join( "", @c_word ) ;
	@items = split ( "/", $xx ) ;
	$nn = scalar ( @items ) ;
#	print " ELSE / nn:", $nn, " items:", @items, "\n" ;
	if ( $xx =~ m/\// )
	{
	    $xx = join (" ", @chrs ) ;
	    $key_list{$key}{'LINE'} = $xx ; # join ( " ", @chrs ) ;
	    $key_list{$key}{"KIND"} = "LIST" ;
	    @{$key_list{$key}{'LIST'}} = @items ; 
#	    print "--------------> ", $key, " = OPTION MENU:", $nn, ':>', @items, "<\n" ;
	}
	else
	{
#    print " -- a_word:", @a_word, "\n" ;
#	    print " -- chrs_word:", @chrs, "\n" ;
#	    print " -- c_word:", @c_word, "\n" ;
	    $xx = join (" ", @chrs ) ;
	    if ( scalar ( @c_word >= 1 ) ) { $xx = join ("", $xx, " [" , @c_word , "] " ) ; }
#	    print " -- X_word:", $xx, "\n" ;
	    $key_list{$key}{'LINE'} = $xx ; # join ( " ", @chrs ) ;
	    $key_list{$key}{"KIND"} = "VALUE" ;
#	    print "--------------> ", $key, " VALUE:", $nn, ':>', $val, "<\n" ;
	}
	
    }
}

sub create_macro
{
    my @system_string = ( $MACRO_FILE ) ;
    
    foreach $key ( sort keys %key_list )
    {
	my $ss_key = "--" . $key ;
	push (@system_string, $ss_key ) ;
	if ( $key_list{$key}{'KIND'} eq "PAIR" || $key_list{$key}{'KIND'} eq "THREES" )
	{ 
#	    print " ARRAY: ", @{$key_list{$key}{'ARRAY'}}, "\n" ;
	    push (@system_string, @{$key_list{$key}{'ARRAY'}} ) ; 
	}
	else 
	{ 	
#	    print " VALUE: ", $key_list{$key}{'VALUE'}, "\n" ;
	    push (@system_string, $key_list{$key}{'VALUE'} ) ;
	}
    }
    push (@system_string, "--doit" ) ;
    my $call = join (" ", @system_string ) ;
    print $call, "\n" ;
    system ( $call ) ;
    exit;
}
