#!/usr/bin/perl -w

#    nack12.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=>'NACK');

$mw->Label(-text=>'Name Averaging by Charlie Kim',
	   )->pack();
$mw->Label(-text=>"Copyright 2002 Charlie Kim GNU General Public License\n")->pack();

# Input #
$inputfr = $mw->Frame(-relief=>'groove',
		      -label=>'PCL Input File',
		      -borderwidth=>2,
		      )->pack(-side=>'top',
			      -anchor=>'nw',
			      -fill=>'both',
			      );
$single_e = $inputfr->Entry(-state=>'normal',
			    -textvariable=> \$singlefile,
			    -width=>30,
			    )->pack(-side=>'left',
				    -pady=>3,
				    );
$inputfr->Button(-text=>'Browse',
		 -command=> \&selectsinglefile,
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'left',
			 );

# Run #
$mw->Button(-text=>"Average Lines by Name",
	    -command=> \&main,
	    -state=> 'normal',
	    )->pack();

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

MainLoop;




sub selectsinglefile {
    my $opentypes = [
		     "{All files}     *           ",
		     "{Text files}    {.txt}      ",
		     ];
    my $file = $mw->getOpenFile(-filetypes=>$opentypes);
    if (defined $file and $file ne '') {
	$single_e->delete(0, 'end');
	$single_e->insert(0, $file);
	$single_e->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 {
    my $infile = $singlefile;
    open(INFILE,$infile) or die "Can't open infile\n";

    use File::Basename;
    my $defaultout = basename($infile);
    $defaultout =~ s/\.\w{3}//;
    $defaultout .= '.nck';
    my $savetypes = [
		     "{All files}     *           ",
		     "{NACK files}    {.nck}      ",
		     "{Text files}    {.txt}      ",
		     ];
		     
    my $outfile = $mw->getSaveFile(-defaultextension=>'nck',
				   -filetypes=>$savetypes,
				   -initialfile=>$defaultout,
				   -title=>'Save Averaged Results',
				   );
    open(OUTFILE,">$outfile") or die "Can't open outfile\n";


    chomp($_=<INFILE>);
    print OUTFILE "$_\n";
    $gweight = 0;
    $gweight = 1 if /GWEIGHT/;

    my %id_data = ();
    my %id_count = ();
    my %newids = ();
    while(<INFILE>) {
	chomp;
	if (/EWEIGHT/) {
	    print OUTFILE "$_\n";
	    next;
	}
	@line = split(/\t/);
	
	my $name = $line[1];
	$name =~ s/^\"//;
	$name =~ s/\"$//;
	next if !$name;
	next if $name !~ /\w/;

	# make new UID #
	$name =~ /\W*(\w{2,10}\d{3,10}\w*)\W/;
	$newid{$name} = $1;

#	print "no newid: $newid{$name}\n" unless $newid{$name};
#	print "newid: $newid{$name}\n";

	for (my $c = $gweight+2 ; $c <= $#line; $c++) {
	    if ($line[$c]) {
		$id_data{$name}[$c] += $line[$c];
		$id_count{$name}[$c] ++;
	    }
	}
    }

    foreach $name (sort {$a cmp $b} keys %id_data) {
	my @temparray = @{$id_data{$name}};
	my @tempcount = @{$id_count{$name}};
	if ($gweight) {
	    print OUTFILE "$newid{$name}\t$name\t1";
	}
	else {
	    print OUTFILE "$newid{$name}\t$name";
	}
	for (my $c = $gweight+2 ; $c <= $#temparray; $c++) {
	    if ($tempcount[$c]) {
		print OUTFILE "\t", $temparray[$c]/$tempcount[$c];
	    }
	    else {
		print OUTFILE "\t";
	    }
	}
	print OUTFILE "\n";
    }

    $mw->bell;
    &errormsg("Program complete");

    close INFILE;
    close OUTFILE;

}