#!/usr/bin/perl
use Getopt::Long;
use strict;
use GD;

#########################################################
#
# RIL.pl
#
# (C) 2005 Richard Mott, Oxford University
#
########################################################


my $pngfile = "ril.png";
my $datafile = "Contributed.chrX.build33.genotypes.txt";
my ($founderA, $founderB) = ("C57BL/6J", "DBA/2J");
my $regex = "^BXD";

GetOptions( "datafile=s"=>\$datafile,  "founderA=s"=>\$founderA, "founderB=s"=>\$founderB, "regex=s"=>\$regex , "png=s"=>\$pngfile);

warn "$datafile \n";

my ( $markers, $genos ) = GetGenos( $datafile );
my $image = RILImage( $genos, $markers, $founderA, $founderB, $regex );

open(PNG, ">$pngfile");
binmode(PNG);
print PNG $image->png;
close(PNG);

sub GetRQTLGenos {
  my ( $datafile ) = @_;
  my @markers;
  my @chrom;
  my @cm;

  my $x;
  my $geno;
  if ( open( DATA, $datafile ) ) {
    $_ = <DATA>;
    chomp;
    ( $x, @markers) = split(/\,/);
    
    $_ = <DATA>;
    chomp;
    ( $x, @chrom) = split(/\,/);
    
    $_ = <DATA>;
    chomp;
    ($x, @cm) = split(/\,/);

    while(<DATA>) {
      chomp;
      my ( $id,@g) = split(/\,/);
      for( my $m=0;$m<=$#markers;$m++) {
	foreach my $snp ( @markers ) {
	  $geno->{$id}{$snp} = $g[$m];
	}
      }
    }
  }
  return $geno;
}

sub GetGenos{
	my  ($datafile ) = @_;
	
	my @markers;
	my $genos;
	if (open(DATA, $datafile ) ) {
		$_ = <DATA>;
		chomp;
		@markers = split;
		shift @markers;
		while(<DATA>) {
			chomp;
			my ( $id,@g ) = split;
			for(my $k=0;$k<=$#g;$k++) {
				$genos->{$id}{$markers[$k]} = $g[$k];
			}
		}
		close(DATA);
	}
	else {
		die "Could not open $datafile\n";
	}

	return ( \@markers, $genos );
}

sub RILImage {
	my ( $genos, $markers, $founderA, $founderB, $regex ) = @_;

	my $nmarkers = $#$markers+1;

	my $font = gdTinyFont;
	my ($w, $h) = ($font->width, $font->height);
	

	my @s;
	my $max = 0;
	foreach my $strain ( keys %$genos ) {
		push @s, $strain if ( ($strain =~ /$regex/) && $strain ne $founderA && $strain ne $founderB );
		my $len = $w*(length($strain)+2);
		$max = $len if ( $max < $len );
	}
	@s = sort @s;
	push @s,  $founderA, $founderB ;
	my $nstrains = $#s +1;
		
	my $w1 = 1;
	my $width = $max + $w1*$nmarkers+2;
	my $h1 = $h+2;
	my $height = $h1*($nstrains+1) +2;
	my $image = new GD::Image( $width, $height );

	my $white = $image->colorAllocate( 255, 255, 255 );
	my $missing = $image->colorAllocate( 255, 255, 255);
	my $strainA = $image->colorAllocate( 255, 150, 0);
	my $strainB = $image->colorAllocate( 255, 255, 0);
	my $both = $image->colorAllocate( 255, 190, 0);
	my $black = $image->colorAllocate( 0, 0, 0);
	my $het = $image->colorAllocate( 100, 100, 100);

	$image->transparent($white);
        $image->filledRectangle(1,1,$width-1,$height-1,$white);

	my $k = 0;
	foreach my $strain ( @s ) {
		my $m = 0;
		foreach my $marker ( @$markers ) {
			$m++;
			my $g = $genos->{$strain}{$marker};
			my $a = $genos->{$founderA}{$marker};
			my $b = $genos->{$founderB}{$marker};
			if ( $g eq $a ) {
				if ( $g eq $b ) {
					$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $both );
				}
				else {
					$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $strainA );
				}
			}
			elsif ( $g eq $b ) {
				$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $strainB );
			}
			elsif ( $g eq "N" ) {
				$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $missing);
			}
			else {
				$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $het );
			}
		}
		$image->string($font, 2,$k*$h1, $strain, $black );
		$k++;
	}

	my $y = $height-$h;
	my $x = $max;
	$image->string( $font, $x, $y, "KEY:", $black );
	 $x += length("KEY:")*$w + $h;
	$image->filledRectangle( $x, $y, $x+$h, $y+$h, $strainA );
	$x += 2*$h;
	$image->string( $font, $x, $y,  $founderA, $black );

	$x += length($founderA)*$w + 2*$h;
	$image->filledRectangle( $x, $y, $x+$h, $y+$h, $strainB );
	$x += 2*$h;
	$image->string( $font, $x, $y,  $founderB, $black );

	$x += length($founderB)*$w + 2*$h;
	$image->filledRectangle( $x, $y, $x+$h, $y+$h, $both );
	$x += 2*$h;
	$image->string( $font, $x, $y,  "both", $black );

	$x += length("both")*$w + 2*$h;
	$image->filledRectangle( $x, $y, $x+$h, $y+$h, $het );
	$x += 2*$h;
	$image->string( $font, $x, $y,  "heterozygote", $black );


	
	return $image;
}