#!/usr/bin/perl -w

# motifsearch.pl
# finds user-specified motifs in a FASTA genome sequence
# v 0.2

#0.1 basic working code
#0.2 added gui

use strict;
use Bio::SeqIO;
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;
use Tk::ErrorDialog;
use Tk::ProgressBar;
use Tk::Balloon;
use Tk::ROText;
use Tk::NoteBook;
use Tk::ErrorDialog;

&lackgui;

sub lackgui {
    my $mw = MainWindow->new(-title=>'Motif Search 0.2');
    
    my $inputfr = $mw->Frame(-relief=>'groove',
			     -borderwidth=>2,
			     )->pack(-side=>'top',
				     -anchor=>'nw',
				     -fill=>'both',
				     );
    
    my $seqfile_label = $inputfr->Label(-text=>'Sequence File',
					)->grid(-row=>0,-column=> 0,-sticky=>'e');
    my $seqfile;
    my $seqfile_e = $inputfr->Entry(-state=>'normal',
				    -textvariable=> \$seqfile,
				    -width=>30,
				    )->grid(-row=>0,-column=> 1,-sticky=>'w');
    $inputfr->Button(-text=>'Browse',
		     -command=> [ \&selectsinglefile, \$seqfile_e , \$mw ],
		     -borderwidth=>1,
		     -padx=> 0,
		     -pady=> 0,
		     )->grid(-row=>0,-column=> 2,-sticky=>'w');
    
    my $full_label =$inputfr->Label(-text=>'Motif',
		                    )->grid(-row=>1,-column=> 0,-sticky=>'e');
    my $motif;
    my $motif_e = $inputfr->Entry(-state=>'normal',
				  -textvariable=> \$motif,
				  -width=>30,
				  )->grid(-row=>1,-column=> 1,-sticky=>'w');

    my $baseabbr1 = <<EOF;
R = G/A (purine)   
Y = T/C (pyrimidine)
K = G/T (keto) 
M = A/C (amino)
EOF

my $baseabbr2 = <<EOF;
S = G/C (strong)
W = A/T (weak)
B = G/T/C
D = G/A/T
EOF

my $baseabbr3 = <<EOF;
H = A/C/T
V = G/C/A
N = A/G/C/T (any)
EOF

    $inputfr->Label(-text=>$baseabbr1,
		    )->grid(-row=>2,-column=>0);
    $inputfr->Label(-text=>$baseabbr2,
		    )->grid(-row=>2,-column=>1);
    $inputfr->Label(-text=>$baseabbr3,
		    )->grid(-row=>2,-column=>2);



    my $buffer_label = $inputfr->Label(-text=>'Sequence buffer size',
		                     )->grid(-row=>3,-column=> 0,-sticky=>'e');
    my $buffer = 10;
    my $datafile_e = $inputfr->Entry(-state=>'normal',
				     -textvariable=> \$buffer,
				     -width=>30,
				     )->grid(-row=>3,-column=> 1,-sticky=>'w');
    
# log window
    my $log_f = $mw->Frame(-relief=>'groove',
			   -borderwidth=>2,
			   )->pack(-fill=>'both',
				   -expand=>1);
    my $logwin = $log_f->Scrolled("Text")->pack(-fill=>'both',
						-expand=>1);
    $logwin->configure(-height=>20,
		       -width=>80,
		       -wrap=>'none',
		       -state=>'disabled',
		       );
    
    
# text options
    my $command_f = $mw->Frame(-relief=>'groove',
			       -borderwidth=>2,
			       )->pack(-fill=>'x');
    $command_f->Button(-text=>"Save Results",
		       -command=> [ \&saveresults,\$mw,\$logwin ],
		       -state=> 'normal',
		       )->grid(-row=>0,
			       -column=>1,
			       -padx=>20,
			       );    
    
    my $statusb = $mw->ROText(-height=>1,
			      -width=>30,
			      -wrap=>'word',
			      -relief=>'flat',
			      -border=>0,
			      )->pack(-side=>'left',
				      -anchor=>'sw');

    if ($^O =~ /mswin/i) {
	$statusb->configure(-background=>'SystemButtonFace');
    }
    else {
	$statusb->configure(-background=>'grey');
    }
    $statusb->insert('end','Idle');
    
    $command_f->Button(-text=>"Find Motifs",
		       -command=> [ \&main,\$seqfile,\$motif,\$buffer,\$logwin,\$statusb,\$mw ],
		       -state=> 'normal',
		       )->grid(-row=>0,
			       -column=>0,
			       -padx=>20,
			       );
    
    $command_f->Button(-text=>"Clear Results",
		       -command=> sub { $logwin->configure(-state=>'normal');
					$logwin->delete('1.0','end');
					$logwin->configure(-state=>'disabled');
				    },
		       )->grid(-row=>0,
			       -column=>2,
			       -padx=>20,
			       );

    $command_f->Button(-text=>"Exit",
		       -command=> sub { exit },
		       )->grid(-row=>0,
			       -column=>3,
			       -padx=>20,
			       );
    MainLoop;
}

# SUBROUTINES #
sub printlog {
    my $line = shift;
    my $logwinref = shift;
    my $logwin = $$logwinref;
    $logwin->configure(-state=>'normal');
    $logwin->insert('end',$line);
    $logwin->yview(moveto=>1);
    $logwin->configure(-state=>'disabled');
    $logwin->update();
}

sub saveresults {
    my $mwref = shift;
    my $mw = $$mwref;
    my $logwinref = shift;
# fix portability
    my $outfile = $mw->getSaveFile(-title=>'Save Results As');
    open(OUTFILE,">$outfile") or die "Can't open output file $outfile\n";
    print OUTFILE $$logwinref->get("1.0","end");
    close OUTFILE;
    $mw->messageBox(-title => 'Finished',
		    -message => 'Results Saved',
		    -type => 'OK');
}

sub selectsinglefile {
    my $entryblankref = shift;
    my $entryblank = $$entryblankref;
    my $mwref = shift;
    my $mw = $$mwref;

    my $file;
    if ($^O =~ /mswin/i) {
	my $opentypes = [
			 "{All files}     *           ",
			 "{PCL files}     {.pcl}      ",
			 "{Text files}    {.txt}      ",
			 ];
	$file = $mw->getOpenFile(-filetypes=>$opentypes);
    }
    else {
	$file = $mw->getOpenFile(-title=>'Load File');
    }
    if (defined $file and $file ne '') {
	$entryblank->delete(0, 'end');
	$entryblank->insert(0, $file);
	$entryblank->xview('end');
    }
}

sub main {
    my $seqfileref = shift;
    my $seqfile = $$seqfileref;
    my $motifref = shift;
    my $motif = $$motifref;
    my $motifbufferref = shift;
    my $motifbuffer = $$motifbufferref;
    my $logwinref = shift;
    my $statusbref = shift;
    my $mwref = shift;
    my $mw = $$mwref;

    if (!$seqfile) {
	$$statusbref->delete('1.0','end');
	$$statusbref->insert('end','Error');
	die "No sequence file specified\n";
	return;
    }

    if (!$motif) {
	$$statusbref->delete('1.0','end');
	$$statusbref->insert('end','Error');
	die "No motif specified\n";
	return;
    }
    
    if (!$motifbuffer) {
	$$statusbref->delete('1.0','end');
	$$statusbref->insert('end','Error');
	die "No motif buffer specified\n";
	return;
    }

    $$statusbref->delete('1.0','end');
    $$statusbref->insert('end','Formatting motifs');
    $mw->update;

    my $motiff = $motif;
    $motiff = &match_form($motiff);
    
    my $motifr = $motif;
    $motifr = &revcom($motifr);
    $motifr = &match_form($motifr);

    my $buffer = '.' x $motifbuffer;
    $motiff = $buffer . $motiff . $buffer;
    $motifr = $buffer . $motifr . $buffer;
    
    &printlog("Search patterns\n",$logwinref);
    &printlog("---------------\n",$logwinref);
    &printlog("forward: $motiff\nreverse: $motifr\n\n",$logwinref);
    
    $$statusbref->delete('1.0','end');
    $$statusbref->insert('end','Reading sequence');
    $mw->update;
    my $seqfileobj = Bio::SeqIO->new(-file => $seqfile,
				     -format => 'fasta'
				     );

    $$statusbref->delete('1.0','end');
    $$statusbref->insert('end','Finding motifs');
    $mw->update;

    while ( my $seqobj = $seqfileobj->next_seq() ) {
	my $seq = $seqobj->seq;
	my $desc = $seqobj->desc;

	&printlog("$desc\n",$logwinref);

	&printlog("\tforward\n",$logwinref);
	while ($seq =~ /($motiff)/gi) {
	    my $position = pos($seq);
	    my $match = $1;
	    &printlog("\t\t$position\t$match\n",$logwinref);
	}

	&printlog("\treverse\n",$logwinref);
	while ($seq =~ /($motifr)/gi) {
	    my $position = pos($seq);
	    my $match = $1;
	    &printlog("\t\t$position\t$match\n",$logwinref);
	}
    }
    &printlog("\n",$logwinref);

    $$statusbref->delete('1.0','end');
    $$statusbref->insert('end','Analysis complete');
    $mw->update;
}

sub match_form {
    my $motif = shift;
    $motif =~ s/r/\[ga\]/gi;
    $motif =~ s/y/\[tc\]/gi;
    $motif =~ s/k/\[gt\]/gi;
    $motif =~ s/m/\[ac\]/gi;
    $motif =~ s/s/\[gc\]/gi;
    $motif =~ s/w/\[at\]/gi;
    $motif =~ s/b/\[gtc\]/gi;
    $motif =~ s/d/\[gat\]/gi;
    $motif =~ s/h/\[atc\]/gi;
    $motif =~ s/v/\[gac\]/gi;
    $motif =~ s/n/\[gact\]/gi;
    return $motif;
}

sub revcom {
    my $oligo = shift;
    $oligo =~ tr/gatcGATC/ctagCTAG/;
    $oligo =~ tr/rykmbdhvRYKMBDHV/yrmkvhdbYRMKVHDB/;
    my $rcoligo = reverse($oligo);
    return $rcoligo;
}