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

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


my $pngfile = "sdp.png";
my $datafile = "Contributed.chrX.build33.genotypes.txt";
my $reference = "C57BL/6J";
my $regex = "(^BXD)|(^AXB)|(^BXA)|(^CXB)|(^BXH)|(^LXS)|(^AKXD)|(^SWXJ)";

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

warn "$datafile \n";

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

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

sub GetGenos{
	my  ($datafile ) = @_;
	
	my @markers;
	my $genos;
	if (open(DATA, "gunzip <$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, $reference, $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 ) {
		if ( ! ($strain =~ /$regex/) && $strain ne $reference ) {
			push @s, $strain;
			my $len = $w*(length($strain)+2);
			$max = $len if ( $max < $len );
		}
	}
	@s = sort @s;
	push @s,  $reference ;
	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->{$reference}{$marker};
			my ( $x,$y) = split(//, $g );
			if ( ($x ne $y) && $y ) {
				$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $het );
			}
			elsif ( $g eq "N" ) {
				$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $missing);
			}
			elsif ( $a eq $g ) {
				$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $strainA );
			}
			else {
				$image->filledRectangle( $max+2 + $m*$w1, $k*$h1, $max+2 +$m*$w1+$w1, ($k+1)*$h1, $strainB );
			}
		}
		$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,  $reference, $black );

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

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

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


	
	return $image;
}