#!/usr/bin/perl -w

#    drack31.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

# Bioperl 0.7.2
# Perl Artistics License


# Input: 2 FASTA format files, < 15kb
# Output: Restriction list w/ fragment lengths

# MODULES #

use Bio::Seq;
use Bio::SeqIO;
use Bio::SeqIO::Fasta;
use Bio::Tools::RestrictionEnzyme;
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=>'DRACK');

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

# Input #

$inputfr = $mw->Frame(-relief=>'groove',
		      -borderwidth=>2,
		      )->pack(-side=>'top',
			      -anchor=>'nw',
			      -fill=>'both',
			      );

@filevars = ();
my @entryvars = ();
for (my $c = 0; $c <= 5; $c++) {
    $inputfr->Label(-text=>'Sequence File',
		    )->grid(-row=>$c,-column=> 0);
    $entryvars[$c] = $inputfr->Entry(-state=>'normal',
				     -textvariable=> \$filevars[$c],
				     -width=>30,
				     )->grid(-row=>$c,-column=> 1);
    $inputfr->Button(-text=>'Browse',
		     -command=> [ \&selectsinglefile, $entryvars[$c] ],
		     -borderwidth=>1,
		     -padx=> 0,
		     -pady=> 0,
		     )->grid(-row=>$c,-column=> 2);
}

$optionfr = $mw->Frame(-relief=>'groove',
		       -borderwidth=>2,
		       )->pack();
$leftopt = $optionfr->Frame()->pack(-side=>'left',
				    -padx=>20,
				    );
$rightopt = $optionfr->Frame()->pack(-side=>'right',
				     -padx=>20,
				     );

$enzset = 0;
$leftopt->Label(-text=>"Cut with: ")->pack(-anchor=>'nw');
$leftopt->Radiobutton(-text=>'All Available Enzymes',
		      -variable=> \$enzset,
		      -value=> 0,
		      )->pack(-anchor=>'nw');
$leftopt->Radiobutton(-text=>'Six cutters',
		      -variable=> \$enzset,
		      -value=> 6,
		      )->pack(-anchor=>'nw');
$leftopt->Radiobutton(-text=>'Five cutters',
		      -variable=> \$enzset,
		      -value=> 5,
		      )->pack(-anchor=>'nw');
$leftopt->Radiobutton(-text=>'Four cutters',
		      -variable=> \$enzset,
		      -value=> 4,
		      )->pack(-anchor=>'nw');

$diff = 1;
$rightopt->Label(-text=>'Select Analysis Type: ')->pack(-anchor=>'nw');
$rightopt->Radiobutton(-text=>'Differential Analysis',
		       -variable=> \$diff,
		       -value=> 1,
		       )->pack(-anchor=>'nw');
$rightopt->Radiobutton(-text=>'List All Cutting Enzymes',
		       -variable=> \$diff,
		       -value=> 0,
		       )->pack(-anchor=>'nw');


# Run #
$mw->Button(-text=>"Run DRACK",
	    -command=> [ \&drackmain, \@filevars ] ,
	    -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();
}

# MAIN #
sub drackmain {
    my $filevars_ref = shift;
    my @tempfiles = @{$filevars_ref};
    my @files = ();
    foreach (@tempfiles) {
	next if !$_;
	push @files, $_;
    }

    %cuts = ();
    foreach $seq (@files) {
	my $sequence = '';
	open(INFILE,$seq) or die "Couldn't open input file\n";
	while(<INFILE>) {
	    next if />/;
	    chomp;
	    $_ =~ s/\r//;
	    $sequence .= $_;
	}

	$sequence = uc($sequence);
	$seqobj = Bio::Seq->new('-seq'=>$sequence,
				'-id'=>$seq,
				'-format'=>'Fasta');

	$seqlen = $seqobj->length();
	
	$re = new Bio::Tools::RestrictionEnzyme(-name=>'EcoRI');
	@enzymes = $re->available_list() if $enzset == 0;
	@enzymes = $re->available_list($enzset) if $enzset > 0;
	
	foreach $enz (sort @enzymes) {
	    $re = new Bio::Tools::RestrictionEnzyme(-name=>$enz);
	    $loc = $re->cut_locations($seqobj);
	    
	    @coords = @$loc;
	    if ($#coords == -1) {
		@sizes = 0;
	    }
	    elsif ($#coords == 0) {
		@sizes = $seqlen;
	    }
	    else { @sizes = &make_size($seqlen, @coords); }
	    
	    $locsites = '';
	    foreach $entry (sort {$a <=> $b} @sizes) {
		$locsites .= "$entry ";
	    }
	    
	    $cuts{$seq}{$enz} = $locsites;
	}
    }

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

    if ($diff == 0) {
	print OUTFILE "Enzyme";
	foreach $seq (sort @files) {
	    print OUTFILE "\t$seq";
	}
	print OUTFILE "\n";
	
	foreach $enz (sort @enzymes) {
	    print OUTFILE "$enz";
	    foreach $seq (sort @files) {
		print OUTFILE "\t$cuts{$seq}{$enz}";
	    }
	    print OUTFILE "\n";
	}
    }
    
    elsif ($diff == 1) {
	print OUTFILE "Enzyme";
	foreach $seq (sort @files) {
	    print OUTFILE "\t$seq";
	}
	print OUTFILE "\n";
	
# check for differential
	@printenz = ();
	foreach $enz (@enzymes) {
	    %seen = ();
	    @patt = ();
	    @uniq = ();
	    foreach $seq (@files) {
		push @patt, $cuts{$seq}{$enz};
	    }
	    foreach $item (@patt) {
		push(@uniq, $item) unless $seen{$item}++;
          }
	    if ($#uniq > 0) {
		push @printenz, $enz;
	    }
	}
	
	foreach $enz (sort @printenz) {
	    print OUTFILE "$enz";
	foreach $seq (sort @files) {
		print OUTFILE "\t$cuts{$seq}{$enz}";
	    }
	    print OUTFILE "\n";
	}
    }
    &errormsg("Processing complete");
}

sub make_size {
    my $len = shift;
    my @coord = @_;
    my @sizes = ();

    for (my $c=0; $c < $#coord; $c++) {
	$frag = $coord[$c+1] - $coord[$c];
	push @sizes, $frag;
    }
    my $wrapsize = $len - $coord[$#coord] + $coord[0];
    push @sizes, $wrapsize;

    return @sizes;
}