use utf8;
use strict;
use GD;
use GD::Text::Align;

binmode(STDIN,":encoding(gbk)");
#如果涉及到输入流，例如读文件，不加这条读中文文件会出现乱码
binmode(STDOUT,":encoding(gbk)");
#标准输出使用gbk作为编码格式，也可以把gbk改为gb2312
binmode(STDERR,":encoding(gbk)");
#如果异常错误中的字符串有中文，请加上STDERR，否则也会出现乱码

###### input parameters and files
my $EVALUE = $ARGV[0];
my $SCORE  = $ARGV[1];
my $HITNUM = $ARGV[2];
my $REPNUM = $ARGV[3];

my @querychr = split(/_/, "$ARGV[4]"); #### query input chromosomes like 1_2_3_4_5_6
my @sbjctchr = split(/_/, "$ARGV[5]"); #### subject input chromosomes like 1_2_3_4_5_6
my $querylen = "$ARGV[6]";  ### file format: chr	bplength	orderlength
my $subjectlen = "$ARGV[7]";
my $querygff = "$ARGV[8]";  ### file format: chr	newid	startpoint	endpoint	direction	order	oldid
my $subjectgff = "$ARGV[9]";
my $blastin = "$ARGV[10]"; ### input blast result files(outfmt6 or m8)
my $legend_query = "$ARGV[11]"; #### legend in horizontal
my $legend_subject = "$ARGV[12]"; #### legend in vertical
my $postion = "order"; #### pos or order
my $figure_file = "result.png";
######
print "\n\tInputing $legend_query chromosome: @querychr\n\n";
print "\tInputing $legend_subject chromosome: @sbjctchr \n\n";

###### parameters for input files
open(QGFF, $querygff) or die "cannot open $querygff due to $! \n";
open(QLEN, $querylen) or die "cannot open $querylen due to $! \n";

my %querygene2pos;
my %querygene2order;
my %querygene2chr;
my %querychr2plen;
my %querychr2olen;

while(<QGFF>)
{
	my @a = split("\t", $_);
	if ($a[0] =~ /^0(\d+)/){$a[0] = $1;}
	$querygene2order{$a[1]}= $a[5];
	$querygene2pos{$a[1]} = $a[2];
	$querygene2chr{$a[1]} = $a[0];

}
while(<QLEN>)
{
	my @a = split("\t", $_);
	if ($a[0] =~ /^0(\d+)/){$a[0] = $1;}
	$querychr2olen{$a[0]} = $a[2];
	$querychr2plen{$a[0]} = $a[1];
}

open(SGFF, $subjectgff) or die "cannot open $subjectgff due to $! \n";
open(SLEN, $subjectlen) or die "cannot open $subjectlen due to $! \n";
my %sbjctgene2pos;
my %sbjctgene2order;
my %sbjctgene2chr;
my %sbjctchr2plen;
my %sbjctchr2olen;

while(<SGFF>)
{
	my @a = split("\t", $_);
	if ($a[0] =~ /^0(\d+)/){$a[0] = $1;}
	$sbjctgene2order{$a[1]}= $a[5];
	$sbjctgene2pos{$a[1]} = $a[2];
	$sbjctgene2chr{$a[1]} = $a[0];

}
while(<SLEN>)
{
	my @a = split("\t", $_);
	if ($a[0] =~ /^0(\d+)/){$a[0] = $1;}
	$sbjctchr2olen{$a[0]} = $a[2];
	$sbjctchr2plen{$a[0]} = $a[1];
}

###### parameters of the figures
my $cell_width = 2;
my $cell_height= $cell_width;
my $frame_width = 2000;
my $frame_height= 2000;

my $left_curb = 200;
my $top_curb  = 200;
######
open(FIG, ">".$figure_file) or die "cannot open $figure_file due to $! \n";

my @querychrlen = ();
my %querychr2order;
my @sbjctchrlen = ();
my %sbjctchr2order;
if($postion eq "order")
{
   for (my $i=0; $i<=$#querychr; $i++)
   {
      my $chr = $querychr[$i];
      $querychrlen[$#querychrlen+1] = $querychr2olen{$chr};
      $querychr2order{$chr} = $#querychrlen;
   }
   for(my $i=0; $i<=$#sbjctchr; $i++)
   {
      my $chr = $sbjctchr[$i];
      $sbjctchrlen[$#sbjctchrlen+1] = $sbjctchr2olen{$chr};
      $sbjctchr2order{$chr} = $#sbjctchrlen;
   }
}
elsif($postion eq "pos")
{
   for(my $i=0; $i<=$#querychr; $i++)
   {
      my $chr = $querychr[$i];
      $querychrlen[$#querychrlen+1] = $querychr2plen{$chr};
      $querychr2order{$chr} = $#querychrlen;
   }

   for(my $i=0; $i<=$#sbjctchr; $i++)
   {
      my $chr = $sbjctchr[$i];
      $sbjctchrlen[$#sbjctchrlen+1] = $sbjctchr2plen{$chr};
      $sbjctchr2order{$chr} = $#sbjctchrlen;
   }
}

my ($genome1_length, $genome2_length) = (0,0);

$genome1_length = sum_chr_len(@querychrlen);
$genome2_length = sum_chr_len(@sbjctchrlen);

#my $querychrno = $#querychrlen + 1;
#my $sbjctchrno = $#sbjctchrlen + 1;

###### calculate scale ratio
my $scale_ratio1 = $genome1_length/$frame_width; ## horizontal
my $scale_ratio2 = $genome2_length/$frame_height;## vertical

print "outerframe: $frame_width, $frame_height\n";
print "genomelength: $genome1_length, $genome2_length\n";
print "per gene scale ratio: $scale_ratio1, $scale_ratio2\n";
####### creat figure 
##### draw the frame and the saprating lines corresponding to chromosome borders
my $img = GD::Image -> new($frame_width + 3/2*$left_curb, $frame_height + 3/2*$top_curb);

####### allocate colors
my $white = $img -> colorAllocate(255,255,255); ### 纯白色
my $black = $img -> colorAllocate(0,0,0); ### 纯黑色
my $red = $img -> colorAllocate(255,0,0); ### 纯红色
my $blue = $img -> colorAllocate(0,0,255); ### 纯蓝色
my $green = $img -> colorAllocate(255,0,255); ### 纯绿色
my $yellow = $img -> colorAllocate(255,255,0); ### 纯黄色
my $gray = $img -> colorAllocate(128,128,128); ### 灰色
my $purple = $img -> colorAllocate(128,0,128); ### 紫色
my $lightyellow = $img -> colorAllocate(255,255,224); ### 浅黄色
my $lightgreen = $img -> colorAllocate(144,238,144); ### 浅绿色
my $cyan = $img -> colorAllocate(0,255,255); ### 青色
my $lightskyblue = $img -> colorAllocate(135,206,250); ### 浅蓝色
my $lightcyan = $img -> colorAllocate(225,255,255); ### 浅青色

####### make the background transparent and interlaced
#$img -> transparent($white); 
$img -> interlaced('true');

####### Put a black frame around the picture
$img -> rectangle($left_curb, $top_curb, $frame_width + $left_curb, $frame_height + $top_curb, $black);
#$img -> rectangle($left_curb-1, $top_curb-1, $frame_width + $left_curb+1, $frame_height + $top_curb+1, $black);
my $align = GD::Text::Align->new($img, valign => 'center', halign => 'center', color => $black);
$align -> set_font('/data/zhanglan/yuzijian/gfca/file_keep/programs/arial.ttf',34);
#$align -> set_font('Arial.ttf',34);
my @query_chro_pos = ();
my @sbjct_chro_pos = ();

my $accumulated_length = 0;
for(my $i=0; $i<=$#querychrlen; $i++)
{
	$accumulated_length += $querychrlen[$i];
	my $length = int($querychrlen[$i]/$scale_ratio1);
	my $posx1 = $left_curb + int($accumulated_length/$scale_ratio1);
	$query_chro_pos[$i] = $posx1;
	my $posy1 = $top_curb;
	my $posx2 = $posx1;
	my $posy2 = $top_curb + $frame_height;
	#print "x chromosome: ".$posx1." ".$posy1." ".$posx2." ".$posy2."\n";
	
	$img -> line($posx1, $posy1, $posx2, $posy2, $lightskyblue);
	$img -> line($posx1+1, $posy1, $posx2+1, $posy2, $lightskyblue);

	my $chr = $querychr[$i];
	$align->set_text($chr);
	$align->draw($posx1-int($length/2)+15, 150,0);
	#$img -> string(gdGiantFont, $posx1-int($length/2)-40, 50, $chr, $red);
}
print "accumulated query chro length is $accumulated_length\n";

$accumulated_length = 0;
for(my $i=0; $i<=$#sbjctchrlen; $i++)
{
	$accumulated_length += $sbjctchrlen[$i];
	my $length = int($sbjctchrlen[$i]/$scale_ratio2);
	my $posy1 = $top_curb + int($accumulated_length/$scale_ratio2);
	$sbjct_chro_pos[$i] = $posy1;
	my $posx1 = $left_curb;
	my $posy2 = $posy1;
	my $posx2 = $left_curb + $frame_width;
	#print "y chromosome: ".$posx1." ".$posy1." ".$posx2." ".$posy2."\n";
	
	$img -> line($posx1, $posy1, $posx2, $posy2, $lightskyblue);
	$img -> line($posx1, $posy1+1, $posx2, $posy2+1, $lightskyblue);

	my $chr = $sbjctchr[$i];
	$align->set_text($chr);
	$align->draw(150, $posy1-int($length/2), 0);#1.57
	#$img -> string(gdGiantFont, 40, $posy1-int($length/2)-40, $chr, $red);
}
$align->set_font('arial.ttf',70);
#$align->set_font('Arial.ttf',70);
$align->set_text($legend_query);
$align->draw($frame_width/2 + $left_curb,65,0);
$align->set_text($legend_subject);
$align->draw(65,$frame_height/2 + $top_curb,1.57);

print "accumulated subject chro length is $accumulated_length\n";

####### input blast file and draw point
#
open(BL,$blastin) or die "can't open blast ! \n";

my $LENGTH = 2; #### Minimum length of block
my $LENGTH2 = 200; #### Maximum length of block
my $PVALUE = 0.05; #### Maximum p-value of block
my $lastquery = "";
my $hitnum = 0; #### hit query or subject number
while (<BL>)
{
	$_ =~ s/[\n\r]//g;
	my ($querygene, $sbjctgene, $identity, $matchlen, $mismatchnum, $gaplen, $querystart, $queryend, $sbjctstart, $sbjctend, $evalue, $score) = split(/\t/, $_);
	my $querychr = $querygene2chr{$querygene};
	my $sbjctchr = $sbjctgene2chr{$sbjctgene};
	# only selected chromosome;
	if($querygene eq $sbjctgene){next;}
	my $is2skip1 = 1;
	for(my $i=0; $i<=$#querychr; $i++)
	{
		if($querychr eq $querychr[$i]){$is2skip1 = 0; last;}
	}
	my $is2skip2 = 1;
	for(my $i=0; $i<=$#sbjctchr; $i++)
	{
		if($sbjctchr eq $sbjctchr[$i]){$is2skip2 = 0; last;}
	}
	if($is2skip1 eq 1 || $is2skip2 eq 1){next;}
	# max hit can not more than HITNUM;
	if($lastquery ne $querygene)
	{
		$hitnum = 1;
		$lastquery = $querygene;
	}
	else
	{
		$hitnum ++;
	}
	if($hitnum > $HITNUM){next;}
	# blast score should be more than SCORE
	if($score < $SCORE){next;}
	# e-value should be less than EVALUE
	if($evalue > $EVALUE){next;}
	#print "query $querychr sbjct $sbjctchr\n";
	my ($posx1, $posy1, $posx2, $posy2, $selfhit1x, $selfhit1y, $selfhit2x, $selfhit2y);
	if($postion eq "order")
	{
		#print "query to order $querychr2order{$querychr}\n";
		if($querychr2order{$querychr} eq 0)
		{
			$posx1 = $left_curb + $querygene2order{$querygene}/$scale_ratio1;
		}
		else
		{
			$posx1 = $query_chro_pos[$querychr2order{$querychr}-1] + $querygene2order{$querygene}/$scale_ratio1;
		}
		#print "sbjct to order $sbjctchr2order{$sbjctchr}\n";
		if($sbjctchr2order{$sbjctchr} eq 0)
		{
			$posy1 = $top_curb + $sbjctgene2order{$sbjctgene}/$scale_ratio2;
		}
		else
		{
			$posy1 = $sbjct_chro_pos[$sbjctchr2order{$sbjctchr}-1] +  $sbjctgene2order{$sbjctgene}/$scale_ratio2;
		}
	}
	elsif ($postion eq "pos")
	{
		#print "query to order $querychr2order{$querychr}\n";
		if($querychr2order{$querychr} eq 0)
		{
			$posx1 = $left_curb + $querygene2pos{$querygene}/$scale_ratio1;
		}
		else
		{
			$posx1 = $query_chro_pos[$querychr2order{$querychr}-1] + $querygene2pos{$querygene}/$scale_ratio1;
		}
		#print "sbjct to order $sbjctchr2order{$sbjctchr}\n";
		if($sbjctchr2order{$sbjctchr} eq 0)
		{
			$posy1 = $top_curb + $sbjctgene2pos{$sbjctgene}/$scale_ratio2;
		}
		else
		{
			$posy1 = $sbjct_chro_pos[$sbjctchr2order{$sbjctchr}-1] +  $sbjctgene2pos{$sbjctgene}/$scale_ratio2;
		}
	}
	#print "posx1 $posx1 poxy1 $posy1\n";
	my $color = $gray;
	if($hitnum == 1){$color = $red;}
	elsif($hitnum == 2){$color = $blue;}
	else{$color = $gray;}
	$img -> filledRectangle($posx1, $posy1, $posx1+3, $posy1+3, $color);
}

binmode FIG;
print FIG $img->png;


###
sub sum_chr_len()
{
	my @chrlen = @_;
	#print "@chrlen[0..$#chrlen]\n";
	my $sumlen = $chrlen[0];
	for(my $i=1; $i<=$#chrlen; $i++)
	{
		#print "input chro len ".$chrlen[$i]."\n";
		$sumlen = $sumlen + $chrlen[$i];
	}
	return $sumlen;
}