#!/usr/bin/env perl

#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#     glang: G-language System Manager
#
#     Copyright (C) 2001 Keio University
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# 
#   $Id: glang,v 1.6 2001/10/08 16:49:09 t98901ka Exp $
#
# G-language System is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
# 
# G-language System is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public
# License along with G-language System -- see the file COPYING.
# If not, write to the Free Software Foundation, Inc.,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# 
#END_HEADER
#
# written by Kazuharu Arakawa <gaou@g-language.org> at
# G-language Project, Institute for Advanced Biosciences, Keio University.
#

package glang;

use strict;
use Gnome;
use SubOpt;
use G::Messenger;
use G::System::BAS;
use Gtk::Gdk::ImlibImage;

my $percent = 0;
my $gcf;
my $GCF_name = '';

if (lstat 'default.gcf'){
    $gcf = 'default.gcf';
}

unless ($ARGV[0] eq ''){
    $gcf = $ARGV[0];
}

my @cf;

init Gnome "gimv", "0.1";

;#######################################################################
;#      main
;#######################################################################

my ($fs_window, $gen_window, $about, $switch_frame, $con_sel);

my $im = load_image Gtk::Gdk::ImlibImage('/usr/local/src/gif/glang_f01.gif');
my $w = $im->rgb_width;
my $h = $im->rgb_height;

my $app = new Gnome::App "G-language System Manager", "G-language System";
my $canvas = Gnome::Canvas->new();
my $width = $w;
my $height = $h;
$canvas->set_usize($width, $height);

my $animation = Gnome::Animator->new_with_size(100,100);
my $fi;
for ($fi = 1; $fi <= 13; $fi ++){
    my $fname = sprintf("glang_f%02d.gif", $fi);
    if ($fi == 13){
	$animation->append_frame_from_file('/usr/local/src/gif/' . 
					   $fname ,0,0,15000);
    }else{
	$animation->append_frame_from_file('/usr/local/src/gif/' . 
					   $fname ,0,0,30);
    }	
}


$animation->set_loop_type("restart");
$animation->start();
show $animation;

signal_connect $app 'delete_event', sub { Gtk->main_quit; return 1 };
signal_connect $app 'destroy_event', sub { Gtk->main_quit; return 1 };

my @menu_info = ({type => 'subtree',
		  label => '_File',
		  subtree => [{type => 'item',
			       label => '_Load Script...',
			       pixmap_type => 'stock',
			       pixmap_info => 'Menu_Open',
			       callback => \&create_file_selection },
			      {type => 'item',
			       label => '_Exit',
			       pixmap_type => 'stock',
			       pixmap_info => 'Menu_Quit',
			       callback => [sub {Gtk->main_quit;}]
			       }]},
		 {type => 'subtree',
		  label => '_Help',
		  subtree => [{type => 'item',
			       label => '_www.g-language.org',
			       callback => \&goto_web
			       },
			      {type => 'item',
			       label=>'_About',
			       pixmap_type=>'stock',
			       pixmap_info=>'Menu_About',
			       callback => \&about_menu
			       }]}
		 );


my $vallbox = new Gtk::VBox;

my $hmainbox = new Gtk::HBox;

my $menubox = new Gtk::VBox;

my $bbox = new Gtk::HButtonBox;

my $hstatbox = new Gtk::HBox;

my $load_msg = $gcf;
$load_msg = 'none' if ($gcf eq '');

my $buffer = "G-language System             Script: $load_msg";
my $label = new Gtk::Label $buffer;
show $label;

my $progress = new Gtk::ProgressBar;
$progress->update($percent);

my $qframe = new Gtk::Frame;
$qframe->set_border_width(5);
$qframe->add($progress);

my $pframe = new Gtk::Frame "Progress:";
$pframe->set_border_width(3);
$pframe->set_shadow_type("etched_in");
$pframe->add($qframe);

$menubox->add($label);
$menubox->add($pframe);
$menubox->add($bbox);

$bbox->set_spacing_default(5);
$bbox->set_border_width(3);

$vallbox->add($hmainbox);
$vallbox->add($hstatbox);

my $frame = new Gtk::Frame;
$frame->set_border_width(3);
$frame->set_shadow_type("out");
$frame->add($animation);

my $outframe = new Gtk::Frame;
$outframe->set_border_width(5);
$outframe->set_shadow_type("etched_in");
$outframe->add($frame);

$hmainbox->add($menubox);
$hmainbox->add($outframe);
$outframe->show();
$frame->show();

my $button = new Gtk::Button "     Configure     ";
signal_connect $button "clicked" => \&configurator;
$bbox->add($button);
show $button;

my $button = new Gtk::Button "     Generate      ";
signal_connect $button "clicked" => \&generator;
$bbox->add($button);
show $button;

my $button = new Gtk::Button "      Execute      ";
signal_connect $button "clicked" => \&executor;
$bbox->add($button);
show $button;


$app->create_menus(@menu_info);
$app->set_contents($vallbox);
$app->show_all();

my $console = &system_console;
&msg::interface("GUI");
&msg::system_console($console);
&msg::error("asimo ver.1.0.0 beta\nG-language System Manager start.\n\n");

&configurator if ($gcf ne '');    

main Gtk;


;#######################################################################
;#      subroutines
;#######################################################################

sub config_window(){
    my $appc = new Gnome::App "G-language System Manager", 
    "Configure $GCF_name";

    $appc->set_usize(600,500);
    signal_connect $appc 'delete_event', sub { hide $appc; 
					       return 1 };
    signal_connect $appc 'destroy_event', sub { hide $appc; 
						return 1 };

    my $svbox = new Gtk::VBox;
    my $middlebox = new Gtk::HBox;
    my $first_sub = -1;

    {
	# Top Genbank file selection frame
	my $outerframe = new Gtk::Frame;
	my $innerframe = new Gtk::Frame "Genbank file";
	$innerframe->set_border_width(10);
	$outerframe->add($innerframe);
	$svbox->pack_start($outerframe,0,0,0);

	my $gbvbox = new Gtk::VBox;
	$innerframe->add($gbvbox);

	my $i = 0;
	while (defined $cf[$i]{type}){
	    $i ++;
	    next unless ($cf[$i]{type} eq 'gb');
	    
	    if ($i == 5000){
		&msg::error("GCF file too long, exiting!\n");
		last;
	    }

	    my $gbhbox = new Gtk::HBox;
	    $gbhbox->set_border_width(5);
	    $gbvbox->add($gbhbox);

	    my $buffer = "\$" . $cf[$i]->{key} . ':';
	    my $label = new Gtk::Label $buffer;
	    show $label;
	    
	    $gbhbox->add($label);
	    
	    my $entry = new Gtk::Entry();
	    $entry->set_usize(350,0);
	    $entry->signal_connect("changed", \&change_gb_entry, $i, $entry);
	    $entry->set_text($cf[$i]->{content});
	    $entry->select_region(length($entry->get_text()));
	    $gbhbox->add($entry);
	    $entry->show();
	}
    }

    {
	# Bottom control buttons
	my $lhbox = new Gtk::HBox;
	$svbox->pack_end($lhbox, 0, 0, 0);
	$svbox->pack_end($middlebox,1,1,0);

	my $button = new Gtk::Button("Save");
	$button->show();
	$button->set_border_width(3);
	$button->signal_connect("clicked", \&con_save_event);
	$lhbox->add($button);
	
	my $button = new Gtk::Button("Save As...");
	$button->show();
	$button->set_border_width(3);
	$button->signal_connect("clicked", \&write_con_selection);
	$lhbox->add($button);
    
	my $button = new Gtk::Button("Close");
	$button->show();
	$button->set_border_width(3);
	$button->signal_connect("clicked", [sub{hide $appc;
						undef @cf;
						undef $appc;
						undef $button;
						undef $svbox;
						undef $lhbox;
					    }]);
	$lhbox->add($button);
    }

    # Middle left window
    my $vbox = new Gtk::VBox;
    my $sw = new Gtk::ScrolledWindow;
    $sw->add_with_viewport($vbox);
    $middlebox->pack_start($sw, 1, 1, 0);

    # Middle right window
    my $outerframe = new Gtk::Frame;
    $middlebox->pack_start($outerframe, 0, 1, 0);

    # Middle left window Creation
    my $i = 0;
    while (defined $cf[$i]{type}){
	$i ++;
	next unless ($cf[$i]{type} eq 'sub');
	$first_sub = $i if ($first_sub == -1);

	my $keyframe = new Gtk::Frame $cf[$i]{name};
	$vbox->add($keyframe);
	my $obox = new Gtk::HBox;
	$keyframe->add($obox);

	# Edit Button
	my $but = new Gtk::Button(" Edit ");
	$but->show();
	$but->set_border_width(5);
	$but->signal_connect("clicked", \&switcher, $i, $outerframe);

	$obox->pack_start($but, 0, 0, 0);

	# ON/OFF Button Box
	my $button =  new Gtk::CheckButton('ON/OFF');
	$button->set_border_width(5);
	$button->set_mode(0);
	if ($cf[$i]{on} eq 'Y'){
	    $button->set_state(1);
	}else{
	    $button->set_state(0);
	}
	$button->signal_connect("toggled", \&toggle_on_button, $i);
	
	$obox->pack_start($button, 0, 0, 0);

	# Order Box
	my $lab = new Gtk::Label 'Order:';
	show $lab;
	$obox->pack_start($lab, 0, 0, 0);
	
	my $entry = new Gtk::Entry;
	$entry->set_usize(30,0);
	$entry->signal_connect("changed", \&change_order_entry, $i, $entry);

	$entry->set_text($cf[$i]{order});
	$entry->select_region(length($entry->get_text()));
	$obox->pack_start($entry, 0, 0, 0);
	$entry->show();
    }

    &create_switch_frame($first_sub, $outerframe);
    $appc->set_contents($svbox);
    $appc->show_all();
}

sub change_opt_entry {
    my ($widget, $i, $j, $entry) = @_;

    $cf[$i]{"val$j"} = $entry->get_text();
}

sub change_order_entry {
    my ($widget, $i, $entry) = @_;

    $cf[$i]{order} = $entry->get_text();
}

sub change_gb_entry {
    my ($widget, $i, $entry) = @_;

    $cf[$i]{content} = $entry->get_text();
}

sub toggle_on_button {
    my ($button, $i) = @_;

    if ($button->get_active() == 0){
	$cf[$i]{on} = 'N';
    }elsif($button->get_active() == 1){
	$cf[$i]{on} = 'Y';
    }
}

sub switcher {
    my ($widget, $i, $outerframe) = @_;

    $outerframe->remove($switch_frame);
    &create_switch_frame($i, $outerframe);
}

sub create_switch_frame {
    my ($i, $outerframe) = @_;
    my $j = 0;

    $switch_frame = new Gtk::Frame $cf[$i]{name};
    $switch_frame->set_border_width(10);
    $outerframe->add($switch_frame);

    my $label = new Gtk::Label $cf[$i]->{comment};
    show $label;
    my $subvbox = new Gtk::VBox;
    $subvbox->show();
    $switch_frame->add($subvbox);
    $switch_frame->show();
    $subvbox->add($label);

    while ($cf[$i]{"opt$j"}){
	my $subhbox = new Gtk::HBox;
	my $subhhbox = new Gtk::HBox;
	my $subvvbox = new Gtk::VBox;
	$subhbox->set_border_width(5);
	$subvvbox->add($subhbox);
	$subvbox->add($subvvbox);
	show $subhbox;
	show $subhhbox;
	show $subvvbox;

	my $entry = new Gtk::Entry();
	$entry->set_usize(200,0);
	$entry->signal_connect("changed", \&change_opt_entry, $i, $j, $entry);
	$entry->set_text($cf[$i]{"val$j"});
	$entry->select_region(length($entry->get_text()));
	$subhbox->pack_end($entry,0,0,0);
	$entry->show();

	my $label = new Gtk::Label $cf[$i]{"opt$j"} . ':';
	show $label;
	$subhbox->pack_end($label,0,0,0);

	my $label2 = new Gtk::Label $cf[$i]{"com$j"};
	show $label2;
	$subhhbox->pack_end($label2,0,0,0);
	$subvbox->add($subhhbox);

	$j ++;
    }
}


sub configurator {
    if ($gcf eq ''){
	&message_open("Script is not loaded.");
	return;
    }

    &parse_gcf();

    &msg::error("read gcf done.\n");
    &config_window();
}

sub generator {
    if ($gcf eq ''){
	&message_open("Script is not loaded.");
	return;
    }

    &generate_file_selection();
}

sub generate_perl {

    my ($widget, $fs) = @_;
    my $fname = $fs->get_filename();

    hide $gen_window;

    G::System::BAS::BAS_run($gcf, -src=>$fname);
    &msg::error("Script generated.\n");
}

sub executor {
    if ($gcf eq ''){
	&message_open("Script is not loaded.");
	return;
    }

    my $term = &terminal;
    &msg::interface("GUI");
    &msg::term_console($term);

    &msg::progress($progress);
    &msg::percent(0);
    &msg::error("Start Analysis:\n");
    my $msg = G::System::BAS::BAS_run($gcf);

    &msg::error("Done.\n");
    sleep(5);
    chdir('../') unless ($msg eq 'HOGE');
}

sub system_console {
    my $console = new Gnome::App "G-language System Manager", "System Console";
    my $sw = new Gtk::ScrolledWindow;
    $console->set_usize(400,150);

    my $text = new Gtk::Text;
    $sw->add($text);

    show $text;
    
    $console->set_contents($sw);
    $console->show_all();

    return $text;
}

sub terminal {
    my $term = new Gnome::App "G-language System Manager", "Text Output";
    my $sw = new Gtk::ScrolledWindow;
    $term->set_usize(400,200);

    my $text = new Gtk::Text;
    $sw->add($text);

    show $text;
    
    $term->set_contents($sw);
    $term->show_all();

    return $text;
}
    

sub parse_gcf {
    require ($gcf);

    my $i = 0;
    my $j = 0;

    my @CONF;
    open(GCF, $gcf);
    while(<GCF>){
	if (/CONF/){
	    while(<GCF>){
		s/\n//g;
		last if (/CONF/);
		push (@CONF, $_);
	    }
	}
    }
    close(GCF);

    while (defined $CONF[$j]){
	my $line = $CONF[$j];
	$line =~ s/\r//g;

	if ($line =~ /^\#/){
	    $cf[$i]{type} = "comment";
	    $cf[$i]{content} .= "$line\n";
	    $j ++;

	    while (defined $CONF[$j] && $CONF[$j] =~ /^\#/){
		$line = $CONF[$j];
		$line =~ s/\r//g;
		$cf[$i]{content} .= "$line\n";
		$j ++;
	    }
	    $i ++;
	    $j --;
	}elsif($line =~ /\$name: (\S*)\s\$/ ){
	    $cf[$i]{type} = "name";
	    $cf[$i]{content} = $1;
	    $GCF_name = $1;
	    $i ++;
	}elsif($line =~ /^(\S+)\s+<\s+(.*)/ ){
	    $cf[$i]{type} = "gb";
	    $cf[$i]{key} = $1;
	    $cf[$i]{content} = $2;
	    $i ++;
	}elsif($line =~ /^>/ ){
	    $cf[$i]{type} = "sub";
	    my @tmpline = split(/\s+/,$line);
	    $cf[$i]{name} = substr($tmpline[0], 1);
	    $cf[$i]{on} = $tmpline[1];
	    $cf[$i]{order} = substr($tmpline[2], 1);

	    my $num = 0;
	    $j ++;

	    while (defined $CONF[$j] && 
		   $CONF[$j] !~ /^\#/ && 
		   $CONF[$j] !~ /^\>/){

		$line = $CONF[$j];
		$line =~ s/\r//g;

		if ($line =~ /^\%/ ){
		    $cf[$i]{comment} = substr($line, 1);
		}elsif ($line =~ /^[a-zA-z0-9]/ || $line =~ /^-/){
		    if ($line =~ /\#/){
			my @tmpline = split(/\#/, $line, 2);
			$cf[$i]{"com$num"} = pop @tmpline;
			$line = shift @tmpline;
		    }
		    my @tmpline = split (/\s/, $line, 2);
		    $cf[$i]{"opt$num"} = shift @tmpline;
		    $cf[$i]{"val$num"} = shift @tmpline;
		    $cf[$i]{"val$num"} =~ s/\t//g;
		    $cf[$i]{"val$num"} =~ s/\s//g;

		    $num ++;
		}else{
		    #&msg::error("$line\n");
		}
		$j ++;
	    }
	    $i ++;
	    $j --;
	}else{
	    #&msg::error("Unparsed: $line\n");
	}

	$j ++;
    }
}

sub con_save {
    my $save = shift;

    open(GCF, $gcf);
    open(OUT, '>' . $save) || die($!);

    while(<GCF>){
	print OUT $_;
	last if (/CONF/);
    }

    my $i = 0;

    while (defined $cf[$i]){
	if ($cf[$i]{type} eq 'name'){
	    print OUT "\$name: " . $cf[$i]{content} . " \$\n\n";
	}elsif ($cf[$i]{type} eq 'comment'){
	    print OUT $cf[$i]{content}, "\n";
	}elsif ($cf[$i]{type} eq 'gb'){
	    print OUT $cf[$i]{key} . ' < ' . $cf[$i]{content} . "\n\n";
	}elsif ($cf[$i]{type} eq 'sub'){
	    my $j = 0;
	    print OUT '>' . $cf[$i]{name} . "\t\t" . $cf[$i]{on} . "\t" . 
		"\@" . $cf[$i]{order} . "\n";
	    print OUT "\%" . $cf[$i]{comment} . "\n";

	    while (defined $cf[$i]{"opt$j"}){
		print OUT $cf[$i]{"opt$j"} . "\t" . $cf[$i]{"val$j"} . "\t";
		print OUT "\#" . $cf[$i]{"com$j"} 
		if (defined $cf[$i]{"com$j"});
		print OUT "\n";
		$j ++;
	    }
	    print OUT "\n";
	}else{
	    #&msg::error($cf[$i]{type}, "\n");
	}
	$i ++;
    }

    while(<GCF>){
	if (/^CONF/){
	    print OUT;
	    while(<GCF>){
		print OUT;
	    }
	}
    }
    close(GCF);
    close(OUT);
    &msg::error("Saved gcf.\n");
}

sub generate_file_selection {

    if (not defined $gen_window){
	$gen_window = new Gtk::FileSelection "Generate Perl Script...";
	$gen_window->position(-mouse);
	$gen_window->set_filename('out.pl');
	$gen_window->signal_connect("destroy_event", 
				   [sub {hide $gen_window;}]
				   );
	$gen_window->signal_connect("delete_event", 
				   [sub {hide $gen_window;}]
				   );
	$gen_window->ok_button->signal_connect("clicked", 
					      \&generate_perl, $gen_window,
					      );
	$gen_window->cancel_button->signal_connect("clicked", 
						  [sub {hide $gen_window;}]
						  );
    }
    if (!visible $gen_window){
	show $gen_window;
    }else{
	hide $gen_window;
    }
}

sub create_file_selection {

    if (not defined $fs_window){
	$fs_window = new Gtk::FileSelection "Save As...";
	$fs_window->position(-mouse);
	$fs_window->set_filename('default.gcf');
	$fs_window->signal_connect("destroy_event", 
				   [sub {hide $fs_window;}]
				   );
	$fs_window->signal_connect("delete_event", 
				   [sub {hide $fs_window;}]
				   );
	$fs_window->ok_button->signal_connect("clicked", 
					      \&open_file_event, $fs_window,
					      );
	$fs_window->cancel_button->signal_connect("clicked", 
						  [sub {hide $fs_window;}]
						  );
    }
    if (!visible $fs_window){
	show $fs_window;
    }else{
	hide $fs_window;
    }
}

sub write_con_selection {

    if (not defined $con_sel){
	my @tmpname = split (/\//, $gcf);
	my $filename = pop @tmpname;

	$con_sel = new Gtk::FileSelection "Save As...";
	$con_sel->position(-mouse);
	$con_sel->set_filename($filename);
	$con_sel->signal_connect("destroy_event", 
				   [sub {hide $con_sel;}]
				   );
	$con_sel->signal_connect("delete_event", 
				   [sub {hide $con_sel;}]
				   );
	$con_sel->ok_button->signal_connect("clicked", 
					      \&save_as_gcf, $con_sel,
					      );
	$con_sel->cancel_button->signal_connect("clicked", 
						  [sub {hide $con_sel;}]
						  );
    }
    if (!visible $con_sel){
	show $con_sel;
    }else{
	hide $con_sel;
    }
}

sub about_menu{
    if (not defined $about){
	$about = new Gnome::About "G-language System", 
	"Version 1.0.0 (asimo)", 
	"",
	['Kazuharu Gaou Arakawa (gaou@g-language.org)',
	 'Koya Mori (mory@g-language.org)',
	 'and others in G-language Project'],
	qq(
	   Copyright (C) 2001 G-language Project
	   Institute of Advanced Biosciences
	   Keio University, JAPAN
	   
	   http://www.g-language.org/);

	$about->position(-mouse);
	$about->signal_connect("delete_event", [sub {
	    undef $about; hide $about
	    }]);
	$about->signal_connect("destroy_event", [sub {
	    undef $about;
	    hide $about}]);
    }
    if (!visible $about){
	show $about;
    }else{
	hide $about;
    }
    undef $about;
}

sub goto_web{
    system('netscape http://www.g-language.org/ &');
    &msg::error('Enjoy!:-)', "\n");
}

sub open_file_event{
    my ($widget, $fs) = @_;
    my $fname = $fs->get_filename();
    $gcf = $fname;

    my @tmpname = split (/\//, $fname);
    my $filename = pop @tmpname;

    if ($filename !~ /\.gcf/){
	&message_open("This is not a .gcf file.");
	return;
    }
    unless (lstat $fname){
	&message_open("No such file.");
	return;
    }

    my $buffer = "G-language System             Script: $filename";
    $label->set_text($buffer);

    &msg::error("GCF File Loaded.");

    hide $fs_window;
}

sub save_as_gcf{
    my ($widget, $con) = @_;
    my $fname = $con->get_filename();

    hide $con;

    &con_save($fname);
}

sub con_save_event{
    my $msg = "This action will overwrite the gcf file. \nReally proceed?";

    my $msgbox = Gnome::MessageBox->new($msg, "alert", "OK", "Cancel");
    my $ret = $msgbox->run();

    return if ($ret);

    my $tmpfile = '/tmp/' . time . '.gcf';
    &con_save($tmpfile);
    system('mv ' . $tmpfile. ' ' . $gcf);
}

sub message_open{
    my $msg = shift;

    my $msgbox = Gnome::MessageBox->new($msg, "alert", "Close");
    $msgbox->run();

}

1;




