#!/usr/bin/perl -w

#    flick11.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=>'FLICK');

$mw->Label(-text=>'File Linker by Charlie Kim',
	   )->pack();
#$mw->Label(-text=>"\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',
			      );
$inrow1fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'top',
				    -anchor=>'nw',
				    -fill=>'both',
				    );
$inrow2fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'top',
				    -anchor=>'nw',
				    -fill=>'both',
			      );
$inrow3fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'top',
				    -anchor=>'nw',
				    -fill=>'both',
				    );
$inrow4fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'top',
				    -anchor=>'nw',
				    -fill=>'both',
				    );
$inrow5fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'top',
				    -anchor=>'nw',
				    -fill=>'both',
			      );
$inrow6fr = $inputfr->Frame(#-relief=>'groove',
			    -borderwidth=>2,
			    )->pack(-side=>'top',
				    -anchor=>'nw',
				    -fill=>'both',
				    );

# File 1 #
$inrow1fr->Label(-text=>'PCL File',
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 -pady=>2,
			 );

$file1_e = $inrow1fr->Entry(-state=>'normal',
			     -textvariable=> \$file1,
			     -width=>30,
			     )->pack(-side=>'left',
				    -anchor=>'nw',
				    -pady=>2,
				    );
$inrow1fr->Button(-text=>'Browse',
		 -command=> [ \&selectsinglefile, $file1_e ],
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 );


# File 2 #
$inrow2fr->Label(-text=>'PCL File',
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 -pady=>2,
			 );

$file2_e = $inrow2fr->Entry(-state=>'normal',
			     -textvariable=> \$file2,
			     -width=>30,
			     )->pack(-side=>'left',
				    -anchor=>'nw',
				    -pady=>2,
				    );
$inrow2fr->Button(-text=>'Browse',
		 -command=> [ \&selectsinglefile, $file2_e ],
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 );

# File 3 #
$inrow3fr->Label(-text=>'PCL File',
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 -pady=>2,
			 );

$file3_e = $inrow3fr->Entry(-state=>'normal',
			     -textvariable=> \$file3,
			     -width=>30,
			     )->pack(-side=>'left',
				    -anchor=>'nw',
				    -pady=>2,
				    );
$inrow3fr->Button(-text=>'Browse',
		 -command=> [ \&selectsinglefile, $file3_e ],
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 );

# File 4 #
$inrow4fr->Label(-text=>'PCL File',
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 -pady=>2,
			 );

$file4_e = $inrow4fr->Entry(-state=>'normal',
			     -textvariable=> \$file4,
			     -width=>30,
			     )->pack(-side=>'left',
				    -anchor=>'nw',
				    -pady=>2,
				    );
$inrow4fr->Button(-text=>'Browse',
		 -command=> [ \&selectsinglefile, $file4_e ],
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 );

# File 5 #
$inrow5fr->Label(-text=>'PCL File',
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 -pady=>2,
			 );

$file5_e = $inrow5fr->Entry(-state=>'normal',
			     -textvariable=> \$file5,
			     -width=>30,
			     )->pack(-side=>'left',
				    -anchor=>'nw',
				    -pady=>2,
				    );
$inrow5fr->Button(-text=>'Browse',
		 -command=> [ \&selectsinglefile, $file5_e ],
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 );

# File 6 #
$inrow6fr->Label(-text=>'PCL File',
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 -pady=>2,
			 );

$file6_e = $inrow6fr->Entry(-state=>'normal',
			     -textvariable=> \$file6,
			     -width=>30,
			     )->pack(-side=>'left',
				    -anchor=>'nw',
				    -pady=>2,
				    );
$inrow6fr->Button(-text=>'Browse',
		 -command=> [ \&selectsinglefile, $file6_e ],
		 -borderwidth=>1,
		 -padx=> 0,
		 -pady=> 0,
		 )->pack(-side=>'left',
			 -anchor=>'nw',
			 );

# Run #
$mw->Button(-text=>"Link PCL Files",
	    -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 {
    my @files = ();
    push @files, $file1 if $file1;
    push @files, $file2 if $file2;
    push @files, $file3 if $file3;
    push @files, $file4 if $file4;
    push @files, $file5 if $file5;
    push @files, $file6 if $file6;

    my %data = ();
    my %headers = ();
    my %names = ();
    my $colcount = 0;

    foreach (@files) {
	my $msgwin = $mw->Toplevel();
	$msgwin->Label(-text=>"Reading $_")->pack();
	$msgwin->update;
	&readdata($_, \%data, \%names, \%headers, \$colcount);
	$msgwin->destroy;
    }

    my $outfile = $mw->getSaveFile();
    open(OUTFILE,">$outfile") or die "Can't open outfile\n";

    print OUTFILE "UNIQID\tNAME";
    foreach (sort {$a<=>$b} keys %headers) {
	print OUTFILE "\t$headers{$_}";
    }
    print OUTFILE "\n";

    foreach (keys %data) {
	my %temp = %{$data{$_}};
	print OUTFILE "$_\t", $names{$_};
#	foreach (sort {$a<=>$b} keys %temp) {
	foreach (sort {$a<=>$b} keys %headers) {
	    if ($temp{$_}) {
		print OUTFILE "\t$temp{$_}";
	    }
	    else { print OUTFILE "\t"; }
	}
	print OUTFILE "\n";
    }

    close OUTFILE;
    $mw->bell();
    &errormsg("Processing complete\n");

}

sub readdata {
    my $file = shift;
    my $dataref = shift;
    my $nameref = shift;
    my $headerref = shift;
    my $colcountref = shift;

    open(FILE,$file) or die "Can't open PCL file\n";

    chomp(my $header=<FILE>);
    $gweight = 0;
    $gweight++ if $header =~ /GWEIGHT/;

    @headercol = split(/\t/, $header);
    shift @headercol;
    shift @headercol;
    shift @headercol if $gweight == 1;

    my $startcol = $$colcountref;
    for (my $c=0; $c <= $#headercol; $c++) {
	next if !$headercol[$c];
	$headerref->{$$colcountref} = $headercol[$c];
	$$colcountref++;
    }

    while (<FILE>) {
	next if /EWEIGHT/i;
	chomp;
	next if !$_;
	my @line = split(/\t/);
	next if !$line[0];

	my $id = $line[0];
	$nameref->{$id} = $line[1];
	for (my $c = 2+$gweight ; $c <= $#headercol + 2 + $gweight; $c++) {
	    my $col = $startcol + $c - 2 - $gweight;
	    $dataref->{$id}{$col} = $line[$c];
	}

    }
    close FILE;
}