#!/usr/bin/perl

use GD;
use CGI qw(:standard);
use DBI;

@legend = ();
$query = "";

&getParams();
&retrieve("$query") || die "Could not execute MySQL query!\n";

my @keys = ();
my @residues = ();
my @Rows = ();
my @unsorted_residues = ('A', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'K', 'L', 'M', 
                         'N', 'P', 'Q', 'R', 'S', 'T', 'V', 'W', 'Y', '*');

#--------------------TABLE REARRANGEMENT FOR SORTED SETS-----------
if(param("sort") eq "on" || param("sort") eq "spread"){
	@sortrow = ();
	$sortby = 0; #default, just in case...
	$sortby2 = 0;
	$have_first = 0;

	if(param("sort") eq "spread"){
		for $i (0 ... $#table){
			if((($table[$i][0] eq $first[0]) || ($table[$i][0] eq $second[0]))
			   && (($table[$i][0] eq $first[0]) || ($table[$i][0] eq $second[0]))
			   && (($table[$i][0] eq $first[0]) || ($table[$i][0] eq $second[0]))){
				if($have_first == 0){
					$sortby = $i;
					$have_first = 1;
				}
				else{
					$sortby2 = $i;
				}
			}
		}
		for $k (4 ... 24){
			push(@unsorted, abs($table[$sortby][$k] - $table[$sortby2][$k]));
		}
	}	

	else{
		# Identify which row in table is the first on the form (i.e. sortby row)
		for $i (0 ... $#table){
			if(($table[$i][0] eq $first[0])
			   && ($table[$i][1] eq $first[1])
			   && ($table[$i][2] eq $first[2])){
				$sortby = $i;
				last;
			}
		}

		for $k (4 ... 24){
			push(@unsorted, $table[$sortby][$k]);
		}
	}

	@sorted = sort numerically(@unsorted);
	for $k (0 ... 20){
		for $n (0 ... 20){
			# Notice I put in an extra test; this is necessary
			# when two residues have the same composition- which
			# to my great surprise is the case with one of the
			# pseudogene sets
			if(($sorted[$n] == $unsorted[$k])
			   && ($keys[$n - 1] != $k)){
				$keys[$n] = $k;
				last;
			}
		}
	}
}

else{
	for $k (0 ... 20){
		$keys[$k] = $k;
	}
}

for $i (0 ... $#table){
	for $j (4 ... 24){
                push(@{ $Rows[$i] }, $table[$i][$keys[$j - 4] + 4]);
        }
        $legend[$i] = $table[$i][0] . " " . $table[$i][1] . " " . $table[$i][2];
}
for $j (0 ... 20){
	push(@residues, $unsorted_residues[$keys[$j]]);
}

&cleanLegend;

#----------------------PLOT CREATION--------------------------------
if($size = param("size")){
        if($size == 20){
                $w = 460;
                $h = 300;
                $step = 20;
        }
        elsif($size == 25){
                $w = 565;
                $h = 360;
                $step = 25;
        }
        elsif($size == 30){
                $w = 670;
                $h = 420;
                $step = 30;
        }
        elsif($size == 40){
                $w = 880;
                $h = 540;
                $step = 40;
        }
        else{
                $w = 460;
                $h = 300;
                $step = 20;
        }
}
else{
        $w = 460;
        $h = 300;
        $step = 20;
}

$plot = new GD::Image($w, $h);

#Basic color allocation
$white = $plot->colorAllocate(255, 255, 255);
$black = $plot->colorAllocate(0, 0, 0);
$colors[0] = $plot->colorAllocate(255, 0, 40);       # Red
$colors[1] = $plot->colorAllocate(255, 180, 0);      # Orange
$colors[2] = $plot->colorAllocate(230, 230, 0);      # Yellow
$colors[3] = $plot->colorAllocate(0, 180, 0);        # Green
$colors[4] = $plot->colorAllocate(40, 40, 220);      # Blue
$colors[5] = $plot->colorAllocate(160, 0, 230);      # Purple

#Axes and labels
$plot->line(25, 40, 25, 40 + (12 * $step), $black);
$plot->line(25, 40 + (12 * $step), 25 + (21 * $step), 40 + (12 * $step), $black);
$plot->string(gdMediumBoldFont, 30, 10, "Amino Acid Frequencies", $black);

for($i = 12; $i >= 1; $i--){
        $plot->line(23, ($step * $i) + (40 - $step), 27, ($step * $i) + (40 - $step), $black);
        $plot->string(gdTinyFont, 2, (40 + (12 * $step)  - ($step * $i) - 4), $i * 0.01, $black);
}

for($i = 1; $i <= 21; $i++){
        $plot->line(($step * $i) + 25, 42 + (12 * $step), ($step * $i) + 25, 38 + (12 * $step), $black);
        $plot->string(gdSmallFont, ($step * ($i - 1)) + 33, 45 + (12 * $step), $residues[$i - 1], $black);
}

#Plotting data set
for $i (0 ... $#Rows){
        $plot->line(210, 8 + (10 * $i), 240, 8 + (10 * $i), $colors[$i]);
        $plot->string(gdTinyFont, 250, 4 + (10 * $i), $legend[$i], $black);

        for($j = 0; $j < 21; $j++){
                $freqpoint = $h - (($Rows[$i][$j] * (100 * $step)) + 20);
                $plot->arc(($step * $j) + (25 + ($step / 2)), $freqpoint, 
                           ($step / 5) - 1, ($step / 5) - 1, 0, 360, $colors[$i]);
                
                if($j > 0){
                        $plot->line(($step * ($j - 1)) + (25 + ($step / 2)), $lastpoint,
                                    ($step * $j) + (25 + ($step / 2)), $freqpoint, $colors[$i]);
                }
                $lastpoint = $freqpoint;
        }
}

print "Content-type: image/gif\n\n";
print $plot->png;

############################################################################
#------------------SUBROUTINES---------------------------------------------#
############################################################################

#I used to keep these in a separate file, but it's less readable and less
#secure that way.

sub numerically { $b <=> $a; }       

sub retrieve {
        
        #----------------------QUERY RETRIEVAL------------------------------
        @table = ();
        my $query = $_[0];

        #Connection block (can be simplified, but useful to preserve syntax)
        my $database = "DBI:mysql:comp:localhost:3306";
        my $db_user = "pseudo";
        my $db_password = "l33t";
        my $scermap = DBI->connect($database,$db_user,$db_password);
        #end connection block
        
        $sql_statement = $scermap->prepare("$query");
        $sql_statement->execute();
        
        #Read output into two-dimensional array for HTML table
        while(my @db_rows = $sql_statement->fetchrow_array()){
                push(@table, [ @db_rows ]);
        }
        $sql_statement->finish();
        $scermap->disconnect;
}

sub cleanLegend {
	
	for $i (0 ... $#legend){
		$legend[$i] =~ s/\ gene/\ genes/;
		$legend[$i] =~ s/\ pseudo/\ pseudogenes/;
		$legend[$i] =~ s/\ homol/\ homologies/;
		$legend[$i] =~ s/\ chr/\ chromosomes/;

		if($legend[$i] =~ /\ all\ /){
			$legend[$i] =~ s/\ all//;
			$legend[$i] .= " (all chrs.)";
		}
		else{
			$chrnum = $legend[$i];
			$legend[$i] =~ s/\ \w*//;
			$chrnum =~ s/\w*\ //;
			$chrnum =~ s/\ \w*//;
			$chrnum = "Chr. $chrnum";
			$legend[$i] .= ", $chrnum";
		}
	}
}

sub getParams {

	#----------------------QUERY ASSEMBLY-------------------------------
	$query = "SELECT * FROM aa WHERE ";
	
	if($plot1 = param("plot1")){
		@p = split(/\./, $plot1);
		@first = @p;
		$query .= "( org = '$p[0]' AND feature = '$p[2]' AND chromosome = '$p[1]' )";
	}
	if($plot2 = param("plot2")){
		@p = split(/\./, $plot2);
		@second = @p;
		$query .= " OR ( org = '$p[0]' AND feature = '$p[2]' AND chromosome = '$p[1]' )";
	}
	if($plot3 = param("plot3")){
		@p = split(/\./, $plot3);
		$query .= " OR ( org = '$p[0]' AND feature = '$p[2]' AND chromosome = '$p[1]' )";
	}
	if($plot4 = param("plot4")){
		@p = split(/\./, $plot4);
		$query .= " OR ( org = '$p[0]' AND feature = '$p[2]' AND chromosome = '$p[1]' )";
	}
	if($plot5 = param("plot5")){
		@p = split(/\./, $plot5);
		$query .= " OR ( org = '$p[0]' AND feature = '$p[2]' AND chromosome = '$p[1]' )";
	}
	if($plot6 = param("plot6")){
		@p = split(/\./, $plot6);
		$query .= " OR ( org = '$p[0]' AND feature = '$p[2]' AND chromosome = '$p[1]' )";
	}

	if(!(param())){
		$query = "SELECT * FROM aa WHERE (org = 'human' OR org = 'fly' OR org = 'worm' OR org = 'yeast') AND feature = 'gene' AND chromosome = 'all'";
	}
}