#!/usr/bin/perl 
#blast2dotplot.pl version 0.0
#author: Sonja J. Prohaska
#  date: 29.04.2005

my $grid = << 'GRI';
@    xaxis  tick major grid on
@    xaxis  tick minor linestyle 2
@    xaxis  tick minor grid on
@    xaxis  tick minor size 0.500000
@    xaxis  type zero true
@    xaxis  tick major 100000
@    xaxis  tick minor ticks 4
@    xaxis  tick out
@    xaxis  type zero false

@    yaxis  tick major grid on
@    yaxis  tick minor grid on
@    yaxis  tick minor linestyle 2
@    yaxis  tick minor size 0.500000
@    yaxis  type zero true
@    yaxis  tick major 100000
@    yaxis  tick minor ticks 4
@    yaxis  tick out
@    yaxis  type zero false

GRI

my $label = << 'LAB';
@    xaxis  ticklabel format decimal
@    xaxis  ticklabel prec 0
@    yaxis  ticklabel format decimal
@    yaxis  ticklabel prec 0

LAB

my $quad= << 'QUA';
@    view xmin 0.150000
@    view xmax 0.850000
@    view ymin 0.150000
@    view ymax 0.850000

QUA


my $color= << 'COL';
@map color 0 to (255, 255, 255), "white"
@map color 1 to (0, 0, 0), "black"
@map color 2 to (148, 0, 211), "violet"
@map color 3 to (255, 0, 255), "magenta"
@map color 4 to (255, 0, 0), "red"
@map color 5 to (255, 165, 0), "orange"
@map color 6 to (0, 255, 0), "green"
@map color 7 to (0, 255, 255), "cyan"
@map color 8 to (0, 0, 255), "blue"

COL

print $grid.$label.$quad.$color;

$set=-1;

my $xlabel = "seq = ".substr($ARGV[1], 0,index($ARGV[1], ".")).", length = ".fasta2length($ARGV[1]);
my $ylabel = "seq = ".substr($ARGV[2], 0,index($ARGV[2], ".")).", length = ".fasta2length($ARGV[2]);
print "\@version 50119\n";
print "@    world 0, 0, ".fasta2length($ARGV[1]).", ".fasta2length($ARGV[2])."\n\n";
print "@    xaxis  label \"$xlabel\"\n";
print "@    yaxis  label \"$ylabel\"\n";

my $sortblast = &blastsort($ARGV[0]);
foreach(@$sortblast){
  my @table = split;
  if (scalar(@table)==12) {
    $set++;
    if ($table[10] eq '0.0'){ 
      print "@ s$set line color 1\n@ s$set symbol color 1\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 1\n@ s$set symbol fill pattern 1\n"} 
    elsif ($table[10] =~ m/e-(\d*)$/){
      if ($1 >= 70){ 
	print "@ s$set line color 2\n@ s$set symbol color 2\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 2\n@ s$set symbol fill pattern 1\n"}
      elsif ($1 >= 50 & $1 < 70){
	print "@ s$set line color 3\n@ s$set symbol color 3\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 3\n@ s$set symbol fill pattern 1\n"}
      elsif ($1 >= 30 & $1 < 50){
	print "@ s$set line color 4\n@ s$set symbol color 4\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 4\n@ s$set symbol fill pattern 1\n"}
      elsif ($1 >= 20 & $1 < 30){
	print "@ s$set line color 5\n@ s$set symbol color 5\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 5\n@ s$set symbol fill pattern 1\n"}
      elsif ($1 >= 10 & $1 < 20){
	print "@ s$set line color 6\n@ s$set symbol color 6\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 6\n@ s$set symbol fill pattern 1\n"}
      elsif ($1 >=  7 & $1 < 10){
	print "@ s$set line color 7\n@ s$set symbol color 7\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 7\n@ s$set symbol fill pattern 1\n"}
      else{ 
	print "@ s$set line color 8\n@ s$set symbol color 8\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 8\n@ s$set symbol fill pattern 1\n"}
    }
    else{
      print "@ s$set line color 8\n@ s$set symbol color 8\n@ s$set symbol 1\n@ s$set symbol size 0.160000\n@ s$set symbol pattern 1\n@ s$set symbol fill color 8\n@ s$set symbol fill pattern 1\n"}

    printf "%7d %7d\n%7d %7d\n&\n", $table[6], $table[8], $table[7], $table[9];
  }
}
print STDERR "$set blast hits (blast2dotplot.pl)\n";


#get the sequence length
sub fasta2length{
  my ($fastafilename)=shift;
  open (SFI, '<', $fastafilename) or die "Can\'t find/read SeqFile \'$fastafilename\'!\n";
  my $seq;
  while (<SFI>){
    chomp;
    if(!($_ =~ m/^>/)){
      my @seq = split;
      $seq .= join('', @seq);
    }
  }
  close(SFI);
  return length($seq);
}

#sort blasthits by evalue (ascending)
sub blastsort{
  my ($file)=shift;
  open(TMP, $file) or die "can't read/find $file\n!";
  my %stmp;
  while(<TMP>){
    my @table = split;
    if(scalar(@table) == 12){
      $stmp{$_}=$table[10];
    }
  }
  my @sort = reverse(sort { $stmp{$a} <=> $stmp{$b} } keys %stmp);
  close(TMP);
  open(OUT, ">out");
  foreach(@sort){
    print OUT $_;
  }
  close(OUT);
  return \@sort;
}
