#!/usr/bin/perl -w

#    ccack10.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 strict;
use Tk;
use Tk::ErrorDialog;
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;


&main();

sub main {
    my $mw = MainWindow->new(-title=>'CCACK');
    $mw->Label(-text=>"Constant Cutoff Analysis by Charlie Kim\n")->pack();
    $mw->Label(-text=>"Copyright 2002 Charlie Kim GNU General Public License\n")->pack();

    my $inputfr = $mw->Frame(-relief=>'groove',
			     -label=>'.pcl or .cdt Input File',
			     -borderwidth=>2,
			     )->pack(-side=>'top',
				     -anchor=>'nw',
				     -fill=>'both',
				     );
    my $singlefile;
    my $single_e = $inputfr->Entry(-state=>'normal',
				   -textvariable=> \$singlefile,
				   -width=>30,
				   )->pack(-side=>'left',
					   -pady=>3,
					   );
    $inputfr->Button(-text=>'Browse',
		     -command=> [ \&selectsinglefile , \$mw, \$single_e  ],
		     -borderwidth=>1,
		     -padx=> 0,
		     -pady=> 0,
		     )->pack(-side=>'left',
			     );
    
    my $cutval = -1;
    my $cutfr = $mw->Frame(#-relief=>'groove',
			   -borderwidth=>2,
			   )->pack(-side=>'top',
				   -fill=>'both',
				   );
    $cutfr->Label(-text=>'Cutoff Value',
		  )->pack(-side=>'left',
			  );
    $cutfr->Scale(-from=>-10,
		  -to=>10,
		  -resolution=>0.1,
		  -variable=> \$cutval,
		  -width=>10,
		  -length=>200,
		  -borderwidth=>1,
		  -orient=>'horizontal',
		  )->pack(-anchor=>'nw');
    
    $mw->Button(-text=>"Convert to binary",
		-command=> [\&ccackmain,\$singlefile,\$cutval,\$mw],
		-state=> 'normal',
		)->pack();
    
    $mw->Button(-text=>"Exit",
		-command=> sub { exit },
		)->pack();
    MainLoop;
}

sub ccackmain {
    my $infileref = shift;
    my $infile = $$infileref;
    my $cutref = shift;
    my $cut = $$cutref;
    my $mwref = shift;
    my $mw = $$mwref;

    open(INFILE,$infile) or die "Can't open infile $infile\n";
    my $outfile = $mw->getSaveFile(-title=>'Save Results As');
    open(OUTFILE,">$outfile") or die "Can't open outfile $outfile\n";

    chomp(my $header=<INFILE>);
    my $gweight = 0;
    my $gid = 0;
    $gweight++ if $header =~ /gweight/i;
    $gid++ if $header =~ /gid/i;
    my $firstDataCol = 2 + $gweight + $gid;

    print OUTFILE "$header\n";

    while (<INFILE>) {
	chomp;
	if (/^AID/i) {
	    print OUTFILE "$_\n";
	    next;
	}
	if (/^EWEIGHT/i) {
	    print OUTFILE "$_\n";
	    next;
	}
	my @line = split(/\t/);
	print OUTFILE "$line[0]";
	for (my $c = 1; $c < $firstDataCol; $c++) {
	    print OUTFILE "\t$line[$c]";
	}
	for (my $d = $firstDataCol; $d <= $#line; $d++) {
	    if ( $line[$d] eq '' ) {
		print OUTFILE "\t";
		next;
	    }
	    elsif ($line[$d] < $cut) {
		print OUTFILE "\t0";
		next;
	    }
	    elsif ($line[$d] >= $cut) {
		print OUTFILE "\t1";
		next;
	    }
	    else { die "Data error\n"; }
	}
	print OUTFILE "\n";
    }

    $mw->bell;
    $mw->Dialog(-title=>'Finished',
		-text=>'Processing complete',
		)->Show();
}

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