#!/usr/bin/perl -w

#    aack10.pl
#    Copyright 2002 Charlie Kim
#
#    This program 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.
#
#    This program 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.
#
#    For a copy of the GNU General Public License, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# This program uses the following modules

# Perl/Tk 800.023  Copyright (c) 1995-1996 Nick Ing-Simmons. 
# http://starbase.neosoft.com/%7Eclaird/comp.lang.perl.tk/ptkFAQ.html


use Tk;
use Tk::Label;
use Tk::Button;
use Tk::Checkbutton;
use Tk::Frame;
use Tk::Entry;
use Tk::Radiobutton;
use Tk::Scale;
use Tk::Scrollbar;
use Tk::Text;

$mw = MainWindow->new(-title=>'AACK');

$mw->Label(-text=>'Add Annotation by Charlie Kim',
	   )->pack();
$mw->Label(-text=>"\nThis program will open a user-specified PCL file and replace the second\ncolumn with a description from the second column of an annotation file\n")->pack();
$mw->Label(-text=>"Copyright 2002 Charlie Kim GNU General Public License\n")->pack();

# Input #
$inputfr = $mw->Frame(-relief=>'groove',
		      -label=>'Input Files',
		      -borderwidth=>2,
		      )->pack(-side=>'top',
			      -anchor=>'nw',
			      -fill=>'both',
			      );
$incol1fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'left',
				    -anchor=>'nw',
				    -fill=>'both',
				    );
$incol2fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'left',
				    -anchor=>'nw',
				    -fill=>'both',
			      );
$incol3fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'left',
				    -anchor=>'nw',
				    -fill=>'both',
				    );


# Annotation File #
$incol1fr->Label(-text=>'Annotation File (2 columns: ID and Name)',
		 )->pack(-side=>'top',
			 -anchor=>'ne',
			 -pady=>3,
			 );

$single_e = $incol2fr->Entry(-state=>'normal',
			    -textvariable=> \$annfile,
			    -width=>30,
			    )->pack(-side=>'top',
				    -anchor=>'nw',
				    -pady=>3,
				    );
$incol3fr->Button(-text=>'Browse',
		 -command=> [ \&selectsinglefile, $single_e ],
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'top',
			 -anchor=>'nw',
			 );

$incol1fr->Label(-text=>'PCL File',
		 )->pack(-side=>'top',
			 -anchor=>'ne',
			 -pady=>3,
			 );

$pcl_e = $incol2fr->Entry(-state=>'normal',
			   -textvariable=> \$pcl,
			   -width=>30,
			   )->pack(-side=>'top',
				   -anchor=>'nw',
				   -pady=>3,
				   );
$incol3fr->Button(-text=>'Browse',
		  -command=> [ \&selectsinglefile, $pcl_e ],
		  -borderwidth=>1,
		  -padx=> 0,
		  -pady=> 0,
		  )->pack(-side=>'top',
			  -anchor=>'nw',
			  );

# Run #
$mw->Button(-text=>"Add Annotations",
	    -command=> \&main,
	    -state=> 'normal',
	    )->pack();

$mw->Button(-text=>"Exit",
	    -command=> sub { exit },
	    )->pack();
MainLoop;



sub selectsinglefile {
    my $entryblank = shift;
    my $opentypes = [
		     "{All files}     *           ",
		     "{PCL files}     {.pcl}      ",
		     "{Text files}    {.txt}      ",
		     ];
    my $file = $mw->getOpenFile(-filetypes=>$opentypes);
    if (defined $file and $file ne '') {
	$entryblank->delete(0, 'end');
	$entryblank->insert(0, $file);
	$entryblank->xview('end');
    }
}

sub errormsg {
    my $msg = shift;
    my $errorwin = $mw->Toplevel();
    $errorwin->Label(-text=> $msg,
		     )->pack();
    $errorwin->Button(-text=>'Close',
		      -command=> sub { $errorwin->destroy },
		      )->pack();
    $errorwin->waitWindow();
}

sub main {
    open(ANNFILE,$annfile) or die "Can't open annotation file\n";
    my %annotation = ();
    while(<ANNFILE>) {
	chomp;
	next if !$_;
	my @line = split(/\t/);
	next if !$line[0];
	my $id = lc($line[0]);
	$annotation{$id} = $line[1];
#	print "id: $id\n";
    }

    open(INFILE,$pcl) or die "Can't open input\n";

    my $outfile = $mw->getSaveFile(-title=>'Save New File As');
    open(OUTFILE,">$outfile") or die "Can't open output file\n";

    chomp($_=<INFILE>);
    print OUTFILE "$_\n";

    while(<INFILE>) {
	chomp;
	if (/EWEIGHT/i) {
	    print OUTFILE "$_\n";
	    next;
	}
	next if !$_;

	$_ =~ /^(\w*)\t/;

	my $id = $1;
	my $lcid = lc($id);
#	print "lcid: $lcid\n";
#	$_ =~ s/^\w*\t*\t/$lcid\t$annotation{$lcid}\t/;
#	print OUTFILE "$_\n";

	my @line = split(/\t/);
	print OUTFILE "$id\t$annotation{$lcid}";
	for (my $c = 2; $c <= $#line; $c++) {
	    print OUTFILE "\t$line[$c]";
	}
	print OUTFILE "\n";

    }

    close INFILE;
    close OUTFILE;
    $mw->bell;
    &errormsg("Processing complete");
}