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

use strict;

my $usage= << "JUS";
  usage: exons2dotplot.pl -x=EXONFILE1 -y=EXONFILE2 [-s=NR_OF_FIRST_SET]
JUS

my @options = grep {substr($_, 0, 1) eq '-'} @ARGV;
my @others  = grep {substr($_, 0, 1) =~ /^[^-]/} @ARGV;

##default settings:
my $debug  = 0 ;
my $ef1;
my $ef2;
my $set=-1;
my $color= << 'COL';
@map color 4 to (255, 0, 0), "red"
COL
##----------

##setting parameters:
foreach my $option (@options){
  if    ($option eq "-d")          { $debug = 1; }
  elsif ($option =~ m/^-x=(.*)$/)   { $ef1 = $1; }
  elsif ($option =~ m/^-y=(.*)$/)   { $ef2 = $1; }
  elsif ($option =~ m/^-s=(\d*)$/){ $set = $1-1; }
  else  { die "Invalid command line option: \'$option\'!\n$usage"; }
}

die "Two exonfiles expected!\n$usage" 
    unless (defined($ef1) & defined($ef2));

my @ef1 = read_exonfile($ef1);
my @ef2 = read_exonfile($ef2);

plot_hoxexons(\@ef1, \@ef2, $set, $color);


sub plot_hoxexons {
  my ($ef1ref, $ef2ref, $set, $color) = @_;
  my @pattern = ('evx', '14', '13', '12', '11', '10', '9', '8', '7', '6', '5', '4', '3', '2', '1');
  
  print "$color\n";
#  foreach my $p (@pattern) {
  foreach my $e1 (@$ef1ref) {
#      if ($e1->[2] =~ m/\D$p/i) {
    foreach my $e2 (@$ef2ref) {
#	  if ($e2->[2] =~ m/\D$p/i) {
      $set++;
#	    if ($p eq 'evx') {print "@ s$set line color 35\n";}
#	    else {print "@ s$set line color $p+20\n";}
      print "@ s$set line color 4\n";
      print $e1->[0] . " " . $e2->[0] . "\n";
      print $e1->[0] . " " . $e2->[1] . "\n";
      print $e1->[1] . " " . $e2->[1] . "\n";
      print $e1->[1] . " " . $e2->[0] . "\n";
      print $e1->[0] . " " . $e2->[0] . "\n";
      print "&\n";
    }
  }
}
#}
#}
#}

# read_exonfile
# returns list consisting of lists with the following elements:
# [0] segment start [1]segment end [2] name of segment
# segments are expected to be genes or exons
sub read_exonfile {
  
  my $exonfile=shift;
  open(EXONFILE, $exonfile)
      or die "Can\'t read EXONFILE $exonfile!\n";
  
  my @exondata;
  my $line=0;
  
  while (<EXONFILE>) {
    $line++;
    if (($_ =~ m/^>/) ||($_ =~ m/^</)) {
      my @gen = split;
      if ( check_exonfile_line(@gen)> 0 ) {
	die "Error at EXONFILE $exonfile line $line: $_ \n";
      }
      shift @gen; #throw away '>' or '<' #com#maybe we should ceep them!
      push @exondata, [@gen];
    }
  }
  return @exondata;
}

sub check_exonfile_line
{
  my @gen = @_;
  if( scalar(@gen)==4 &&
      ($gen[0] eq '>' || $gen[0] eq '<') &&
      int($gen[1]) eq $gen[1] &&
      int($gen[2]) eq $gen[2] &&
      $gen[1] <= $gen[2])
  {return 0}
  else
  {return 1}
}
