Draw_chromosome_GD_simple.pl

use strict;
use warnings;
use GD::Simple;
use Getopt::Long;

our($blastfile,$haplofile,$chrlen,$sample_order,$sample_name,$user_sample_only,$chr_order,$user_chr_only,%label_info, $min_num_allele, $max_num_allele,,$chr_color, $help, $color_by_type_allele,$mar_list,%mar_list,$use_list_color,$invert_axis,$less_than_column_2,$more_than_column_2,$out_file,$print_allele_density,$marker_width,$label_marker,$label_dist,$label_overlap,$alpha1,$print_consensus,$cons_color,$max_only,$add_line_start,$add_line_end,$add_line_chr,$add_line_samp,$merge_samples,$rgb_start,$rgb_end);

#### arrange sample names per user list.
#my@sample_order=qw(Japonica.1660	Japonica.1663	Japonica.1708	Japonica.2040	Japonica.3559	Japonica.Meyer	Japonica.Zenith_5226-50	Macrostachya.2233	Macrostachya.3501	Macrostachya.2195	Macrostachya.3507	Sinica.2139	Sinica.2147	Sinica.3538	Sinica.3578	Crowne_2R	Japonica.Crowne	Japonica.Eltoro	Jamur_2R	Japonica.JaMur	Japonica.Palisades	Macrantha.4415	Matrella.Cavalier	Matrella.Royal	Zeon_2R	Matrella.Zeon	Matrella.Zorro	Cashmere_2R	Matrella.Cashmere_6003	Shadowturf_2R	Matrella.Shadowturf	Macrantha.5186-16	Minima.5194-5	Japonica.2097	Japonica.Carrizo	Macrantha.5193-19	Matrella.1555	Matrella.1565	Matrella.1569	Matrella.1572	Matrella.Diamond	Pacifica.1688	Pacifica.1993	Pacifica.2001	Pacifica.2043	Pauciflora.5195-25);
my@sample_order=qw(Chr1 Chr2 Chr3 Chr4 Chr5 Chr6 Chr7 Chr8 Chr9 Chr10 Chr11 Chr12);
$label_dist=25;
$label_overlap=25;
#my@sample_order=qw(Crowne_2R	Japonica.Crowne);

my$window_H=600;## height of chr window
my$window_W=30; ## width of chr window
my$pad_wy=30;  ## pad in window on y axis
my$thickness=20;  ## thickness of the chromosomes.
my$pad=200;  ## image padding.
my$fontsize=20;
my$marker_shape='line';
my$marker_height=1;
$max_num_allele=1000;
$chr_color="white";
$min_num_allele=0;
my%drawing_coord;
my$max_color=4;
my@rgb_start=(0,0,255);
my@rgb_end=(255,0,0);
my$result=GetOptions(
  "map|m=s"=>\$blastfile,
  "haplo=s"=>\$haplofile,
  "chr|cl=s"=>\$chrlen,
  "mlist|mls=s"=>\$mar_list,
  "ulc"=>\$use_list_color,
  "chr_color|cc=s"=>\$chr_color,
  "sample_order|so=s"=>\$sample_order,
  "user_sample_only|uso"=>\$user_sample_only,
  "chr_order|co=s"=>\$chr_order,
  "user_chr_only|uco"=>\$user_chr_only,
  "min_num_allele|mna=i"=>\$min_num_allele,
  "max_num_allele|xna=i"=>\ $max_num_allele,
  "cbta"=>\$color_by_type_allele,
  "wh=i"=>\$window_H,
  "ww=i"=>\$window_W,
  "pwy=i"=>\$pad_wy,
  "ct=i"=>\$thickness,
  "pad=i"=>\$pad,
  "mshape=s"=>\$marker_shape,
  "mwidth=i"=>\$marker_width,
  "mheight=i"=>\$marker_height,
  "mlabel" => \$label_marker,
  "mldist=i"=> \$label_dist,
  "mlovlap=i"=>\$label_overlap,
  "sname=s"=>\$sample_name,
  "fs=i"=>\$fontsize,
  "ia"=>\$invert_axis,
  "ltc2=f"=>\$less_than_column_2,
  "gtc2=f"=>\$more_than_column_2,
  "out=s"=>\$out_file,
  "pald"=>\$print_allele_density,
  "max_color=i"=>\$max_color,
  "alpha=i"=>\$alpha1,
  "concensus|pc"=>\$print_consensus,
  "conscolor=s"=>\$cons_color,
  "max_only|mo"=>\$max_only,
  "als=i"=>\$add_line_start,
  "ale=i"=>\$add_line_end,
  "alc=s"=>\$add_line_chr,
  "alm=s"=>\$add_line_samp,
  "merge_sample|merge|ms"=>\$merge_samples,
  "rgbs=s"=>\$rgb_start,
  "rgbe=s"=>\$rgb_end,
  "help|h"=>\$help,

);


$sample_order=$sample_order?$sample_order:join("\t",@sample_order);
#$chr_order="Chr01,Chr02";
$marker_width=$marker_width?$marker_width:$thickness;
my$alpha=$alpha1?int(127*$alpha1/100):0;
#print "\nAlpha:$alpha\n";
$cons_color=$cons_color?$cons_color:"lightgreen";

@rgb_start=split(/\,|\s+/,$rgb_start) if $rgb_start;
@rgb_end=split(/\,|\s+/,$rgb_end) if $rgb_end;

s/\s+//g foreach @rgb_start;
s/\s+//g foreach @rgb_end;


##############################################################################################
#### write usage help and print if asked
my$usage="
  -map      map file with markers location on chromosomes.3 column: Marker chr location,
  -haplo    haplofile generated by stacks or modified haplo. col1:MarkerName,Col2:CountReads,Col3 and others as sample:haplotype
  -chr      chrlen info; Columns: Chr  Length.,

  -cc       chromosome body color [white]
  -wh       Height of the chromosome body [300].
  -ct       Chromosome body thickness[20]
  -ww       Width of chromosome window [30].
  -pwy      Padding inside chromosome window on y axis[30].
  -pad      Padding of the image on y and x axises [200]
  -fs       Fontsize for text labels [20]
  -ia       Invert axis and draw samples on Y-axis and Chromosomes on X-axis.
            Default: Chromosome on Y-axis, Samples on X-axis
  -ms       Merge samples. draw all samples in one set of chromosome.
  -mshape   shape of markers on chromosome [line] or circle
  -mwidth   width of marker. [$thickness]
  -mheight  height of markers [1]
  -mlabel   add marker names as label.
  -mldist    horizontal distance of marker name from chromosome[25]
  -mlovlap  vertical distance between the marker labels.
  -sname  sample name [blast file name]
  -alpha    Transparency in percent [0]
            0 means opaque and 100 means completely transparent.
  -mo       Max num allele stays on top for each locus.
  -conscolor Color of concensus markers.
  -max_color Use this many color to create gradient;
  -rgbs     RGB value for color start[0,0,255]
  -rgbe     RGB value for end of color gradient[255,0,0]
  -pc       Draw markers marked as consensus too.
  -mls      marker list file to show on chromsomes. Only show these markers.
  -ulc      Use colors defined in -mls file as marker_name\tcolor
  -so       sample_order,list seperated by space or comma.
  -uso      user_only samples,
  -co       Chromosome order. list seperated by space or comma.
  -uco      user defined chromosomes only.
  -mna      Minimum number of allele per locus to show on chromosome
  -xna      Maximum number of alleles per locus to show on the chromosome
  -ltc2     Exclude if value in column 2 is less than this.
  -gtc2     Exclude if value in column 2 is greater than this.
  -cbta     Color markers by type of alleles per locus [num allele per locus].
  -pald     Print allele density in seperate file.
  -out      Save output as this filename.
  -help     help.


Mark a location on chromosome
   -alc     chromosome name
   -alm     sample name
   -als     rectangle start location
   -ale     rectanh=gle end location
";

die "\n\n$usage\n\n" if $help;
##############################################################################################
#### Read blast/ mapping info and store them in hash.

$blastfile || die "\nRequire input file....\n$usage\n";
open(BLAST,"$blastfile") or die "\nCannot open Mapping/blast file\n$usage\n\n";
my %chrlocs;
my %chrlist;
my $max_chr_size=0;
my%chr_sort;
my %haplos;
my%name_list;
$sample_name=$sample_name?$sample_name:$blastfile;
### collect markers location on reference genome.
while (<BLAST>) {
   next if /^\s*$/;
   my($marker,$chr,$loc,$ext)=split(/\s+/,$_);
   chomp($marker,$chr,$loc,$ext);
   #my$chrnum=$chr=~/\D+(\d+)/?$1:"";
   $chrlocs{$marker}{'chr'}=$chr;
   $chrlocs{$marker}{'loc'}=$loc;
   $chrlocs{$marker}{'color'}=$ext;
   $chrlist{$chr}{'max'}=$loc if $chrlist{$chr}{'max'}?$chrlist{$chr}{'max'}:0 < $loc;
   $max_chr_size=$loc if $max_chr_size < $loc;
   #$chrlist{$chr}{'num'}=length($chrnum)>0?$chrnum:100;
   $haplos{$sample_name}{$marker}{'allele'}='black';
   $haplos{$sample_name}{$marker}{'color'}='black';
   $name_list{$sample_name}=1;
   print "Read Marker:$marker chr:$chr loc:$loc\n";
}
close BLAST;
##sort chr based on number.
my@chr_names=sort{only_nums($a,100)<=> only_nums($b,100) } keys %chrlist;
my$total_len=0;
$total_len+=$chrlist{$_}{'max'} foreach keys %chrlist;
print "\nChromosomes:",join(",",@chr_names,"\n"),"\n";

##############################################################################################
### create user defined order of samples and chromosomes.
my%temp_chr_list=%chrlist;

if($chr_order){
   @chr_names=();
   print "\nChrOrdr:$chr_order";
   $chr_order=~s/^\s+|^\,+//g;
   @chr_names=split(/\s+|\,/,$chr_order);
   chomp(@chr_names);
   print "\nChrOrdr after Split:",join(",",@chr_names);

   ### check if Chr names in the order exists. Remve themfrom the list if they dont exists. Keeping them will create empty chromosome in the figure.
   for(my$i=0;$i<scalar@chr_names;$i++) {
      #print "\nChecking if :$chr_names[$i] exists";
      if (!defined $temp_chr_list{$chr_names[$i]}){
         print "\nChromosome name :$chr_names[$i] does not exists. Please check the names of Chromosomes.\n";
         splice(@chr_names,$i,1);
         $i--;
      }
   }
   delete $temp_chr_list{$_} foreach @chr_names;
   if(!$user_chr_only){push(@chr_names,$_) foreach sort{only_nums($a,100)<=> only_nums($b,100) } keys %temp_chr_list}

}
### create hash of allowed chromosomes to exclude markers not related to allowed chrs.
my%allowed_chrs;
$allowed_chrs{$_}=$_ foreach @chr_names;
my$longest_chrname=0;
foreach (@chr_names){$longest_chrname=length($_)>$longest_chrname?length($_):$longest_chrname }

##################################################################################################
my%allowed_samples;
my @sample_names=$sample_name?($sample_name):($blastfile);
$allowed_samples{$_}=1 foreach @sample_names;
my$longest_samplename=0;
foreach (@sample_names){$longest_samplename=length($_)>$longest_samplename?length($_):$longest_samplename }

die "\nNo Sample left in the sample list:@sample_names\nExiting.\n" if scalar@sample_names <1;
#

##############################################################################################
#### collect chromosome length info on each chromosome
my %chrlen;
if ($chrlen) {
   open(CHRLEN,"$chrlen");

   $total_len=0;
   while (<CHRLEN>) {
      next if /^\s*$/;
      my($chr_name,$chr_len,$chr_centro)=split /\s+/;
      chomp($chr_name,$chr_len,$chr_centro);
      $chrlen{$chr_name}{'len'}=$chr_len;
      $chrlen{$chr_name}{'centro'}=$chr_centro?$chr_centro:0;
      $max_chr_size=$chr_len if ($max_chr_size < $chr_len && defined $allowed_chrs{$chr_name});
      $total_len+=$chr_len if defined $allowed_chrs{$chr_name};

   }
}


##############################################################################################
#### collect markers name to show on chromosomes and also color for that marker if defined..
if ($mar_list) {

   open(MLIST,"$mar_list");
   while (<MLIST>){
      s/^\s+|\s+$//g;
      next if /^\s*$/;
      my($marker,$color)=split /\s+/;
      $color=$color?$color:'none';
      s/\s+//g foreach ($marker,$color);
      $mar_list{$marker}=$color;
      #print "\nAssigning color:$mar_list{$marker}\t to marker $marker";
      if (!$haplofile) {
         $haplos{$sample_name}{$marker}{'allele'}=$color;
         $haplos{$sample_name}{$marker}{'color'}=$color;
         $name_list{$sample_name}=1;
      }
   }

}






#############################################################
#### draw image for chromosomes. $window_W width per sample; $window_H length per chromosome.

##assign start x points to every chromosome
my%coords;
my$next_x=0;   ## jump to next chr.
my$next_y=0; ## jump to next sample
my$bp_perpixel= int($max_chr_size/($window_H - 2*$pad_wy));
$pad=$pad>$fontsize*$longest_samplename?$pad:$fontsize*$longest_samplename;
my$img_width=(scalar@sample_names)*$window_W+$pad+$pad;
my$img_height=scalar(@chr_names)*$pad_wy*2+2*$pad+$total_len/$bp_perpixel;
###img width and height will change if axis are inverted.
if ($invert_axis) {

   $pad=$pad>$fontsize*$longest_chrname?$pad:$fontsize*$longest_chrname;
   $img_height=(scalar@sample_names)*$window_H+$pad+$pad;
   $img_width=scalar(@chr_names)*$window_W+2*$pad;
}

my$img = GD::Simple->new($img_width,$img_height);

#############################################################
###########   Drawing Chromosomes on canvas    #############
#############################################################
########################################################################################################
#### color options "red","pink","green","lime","blue","deepskyblue","aqua","yellow","black";
my %marker_color=('Chromosome' => $chr_color,'consensus' => $cons_color);
my %name=('Chromosome'=>'Chromosomes','consensus'=> 'consensus');
my @colors;


for my$i(0 .. $max_color-1){

   my$fraction=( 1/($max_color-1)) * $i;
   my$refArrayRGB=create_gradient($fraction,$rgb_start[0],$rgb_start[1],$rgb_start[2],$rgb_end[0],$rgb_end[1],$rgb_end[2]);
   $marker_color{$i}=$img->colorAllocate(@$refArrayRGB[0],@$refArrayRGB[1],@$refArrayRGB[2]);
   $name{$i} = join " ",$i+1,"Alleles";
   $name{$i}=join "",">",$i+1," Alleles" if $i == $max_color-1;
   #print"\ndefined Color:$i:\twithFraction:$fraction\t\t",join ",",@$refArrayRGB;

}











#########################################################################################################################################
#########################################################################################################################################
#########################################################################################################################################
### test to draw Chromosomes in columns (on x axis) and samples in rows (on y axis).

## draw all the chromosome for each sample on canvas. Collect x and y coordinates for each.
if ($invert_axis) {
my$count_samp=0;
for (my$i=0;$i<scalar@sample_names;$i++){
   my$count_chr=0;
   my$current_window_y1=$pad+($count_samp*$window_H);
   print "\nDrawing chromosome for $i:$sample_names[$i]:";

   foreach my$chrs(@chr_names){

      my$chr_len_pixel=($chrlen{$chrs}{'len'}?$chrlen{$chrs}{'len'}:$chrlist{$chrs}{'max'})/$bp_perpixel;
      $coords{$sample_names[$i]}{$chrs}{'x1'}= $pad + ($count_chr*$window_W) + $window_W/2-$thickness/2;
      $coords{$sample_names[$i]}{$chrs}{'y1'}= $current_window_y1 + $pad_wy;
      $coords{$sample_names[$i]}{$chrs}{'x2'}= $coords{$sample_names[$i]}{$chrs}{'x1'}+$thickness;
      $coords{$sample_names[$i]}{$chrs}{'y2'}= $coords{$sample_names[$i]}{$chrs}{'y1'} + $chr_len_pixel;

      my$centromere_loc=int (($chrlen{$chrs}{'centro'}?$chrlen{$chrs}{'centro'}:0)/$bp_perpixel);


      #print "\n***chrLen:$chrlen{$chrs}{'len'}\tCentroLoc:$chrlen{$chrs}{'centro'}\tY1:$coords{$sample_names[$i]}{$chrs}{'y1'}\ty2:$coords{$sample_names[$i]}{$chrs}{'y2'}\tCentromere:$centromere_loc\tBpperpixel:$bp_perpixel";
      $count_chr++;
      Add_chromosome(\$img,$coords{$sample_names[$i]}{$chrs}{'x1'},$coords{$sample_names[$i]}{$chrs}{'y1'},$coords{$sample_names[$i]}{$chrs}{'x2'},$coords{$sample_names[$i]}{$chrs}{'y2'},$marker_color{'Chromosome'},'black',$centromere_loc);

   }
   $count_samp++ if !$merge_samples;
}

#### add names of the chromosome.
for (my$i=0;$i<scalar@chr_names;$i++){
    $img->bgcolor('black');
    $img->fgcolor('black');
    $img->moveTo($coords{$sample_names[0]}{$chr_names[$i]}{'x1'}+$thickness/1.2,
                 $coords{$sample_names[0]}{$chr_names[$i]}{'y1'} - $pad_wy);
   #print "\nsample_name:$sample_names[0]\tChr_name:$chr_names[$i]\tx1:$coords{$sample_names[0]}{$chr_names[$i]}{'x1'}\tthickness:$thickness/1.2\ty1:$coords{$sample_names[0]}{$chr_names[$i]}{'y1'}\tpad_wy$pad_wy";
    $img->font('Times:italic');
    $img->fontsize($fontsize);
    $img->angle(-90);
    $img->string($chr_names[$i]);
}


#### add names of the samples.
for (my$i=0;$i<scalar@sample_names;$i++){
    $img->bgcolor('black');
    $img->fgcolor('black');
    $img->moveTo($coords{$sample_names[$i]}{$chr_names[0]}{'x1'}- $thickness,
                 $coords{$sample_names[$i]}{$chr_names[0]}{'y1'} + $window_H/2+ length($sample_names[$i])+ $fontsize/2);
    $img->font('Times:italic');
    $img->fontsize($fontsize);
    $img->angle(-90);
    $img->string($sample_names[$i]);

}
}


else{

## draw all the chromosome for each sample on canvas. Collect x and y coordinates for each.
my$count_samp=0;
for (my$i=0;$i<scalar@sample_names;$i++){
   my$count_chr=0;
   my$old_y2 = $pad;
   print "\nDrawing chromosome for $i:$sample_names[$i]:";

   foreach my$chrs(@chr_names){
      $coords{$sample_names[$i]}{$chrs}{'x1'}= $pad + ($count_samp*$window_W) + $window_W/2-$thickness/2;
      $coords{$sample_names[$i]}{$chrs}{'y1'}= $old_y2 + $pad_wy;
      $coords{$sample_names[$i]}{$chrs}{'x2'}= $pad + ($count_samp*$window_W) + $window_W/2+$thickness/2;
      $coords{$sample_names[$i]}{$chrs}{'y2'}= $coords{$sample_names[$i]}{$chrs}{'y1'} + ($chrlen{$chrs}{'len'}?$chrlen{$chrs}{'len'}:$chrlist{$chrs}{'max'})/$bp_perpixel;

      my$centromere_loc=int (($chrlen{$chrs}{'centro'}?$chrlen{$chrs}{'centro'}:0)/$bp_perpixel);


      #print "\n***chrLen:$chrlen{$chrs}{'len'}\tCentroLoc:$chrlen{$chrs}{'centro'}\tY1:$coords{$sample_names[$i]}{$chrs}{'y1'}\ty2:$coords{$sample_names[$i]}{$chrs}{'y2'}\tCentromere:$centromere_loc\tBpperpixel:$bp_perpixel";
      $count_chr++;
      Add_chromosome(\$img,$coords{$sample_names[$i]}{$chrs}{'x1'},$coords{$sample_names[$i]}{$chrs}{'y1'},$coords{$sample_names[$i]}{$chrs}{'x2'},$coords{$sample_names[$i]}{$chrs}{'y2'},$marker_color{'Chromosome'},'black',$centromere_loc);
      $old_y2=$coords{$sample_names[$i]}{$chrs}{'y2'};
   }
   $count_samp++;
}

#### add names of the chromosome.
for (my$i=0;$i<scalar@chr_names;$i++){
    $img->bgcolor('black');
    $img->fgcolor('black');
    $img->moveTo($coords{$sample_names[0]}{$chr_names[$i]}{'x1'}-$pad/2,
                 $coords{$sample_names[0]}{$chr_names[$i]}{'y1'}+(($chrlen{$chr_names[$i]}{'len'}?$chrlen{$chr_names[$i]}{'len'}:$chrlist{$chr_names[$i]}{'max'})/$bp_perpixel)/2 + $pad_wy);
    $img->font('Times:italic');
    $img->fontsize($fontsize);
    $img->angle(0);
    $img->string($chr_names[$i]);
}


#### add names of the samples.
for (my$i=0;$i<scalar@sample_names;$i++){
    $img->bgcolor('black');
    $img->fgcolor('black');
    $img->moveTo($coords{$sample_names[$i]}{$chr_names[0]}{'x1'}+$thickness/1.2,$coords{$sample_names[$i]}{$chr_names[0]}{'y1'}-$fontsize);
    $img->font('Times:italic');
    $img->fontsize($fontsize);
    $img->angle(-90);
    $img->string($sample_names[$i]);

}



}

#### END test to draw chromosomes in columns
#########################################################################################################################################
#########################################################################################################################################
#########################################################################################################################################
#########################################################################################################################################



########################################################################################################
###### add legend for color codes
###### color options "red","pink","green","lime","blue","deepskyblue","aqua","yellow","black";
#my$start_x1=$coords{$sample_names[0]}{$chr_names[$#chr_names]}{'x1'};
#my$start_y1=$coords{$sample_names[0]}{$chr_names[$#chr_names]}{'y1'}+(($chrlen{$chr_names[$#chr_names]}{'len'}?$chrlen{$chr_names[$#chr_names]}{'len'}:$chrlist{$chr_names[$#chr_names]}{'max'})/$bp_perpixel) + 3*$pad_wy ;
#$longest_chrname=length("Chromosome") if $longest_chrname<length("Chromosome");
#if (!$color_by_type_allele && !$use_list_color) {
#
#    my $one_block = $thickness;
#    my$legend_count=0;
#    my$shift=0;
#    ###start_x will be x coordof first chromosome or last sample.
#    $start_x1=$coords{$sample_names[$#sample_names]}{$chr_names[0]}{'x1'} if $invert_axis;
#    $start_y1=$coords{$sample_names[$#sample_names]}{$chr_names[0]}{'y1'}+(($max_chr_size?$max_chr_size:$chrlist{$chr_names[scalar@chr_names -1]}{'max'})/$bp_perpixel) + 3*$pad_wy if $invert_axis ;
#    #(scalar@sample_names)*$window_W+$pad+$pad,
#    #scalar(@chr_names)*$pad_wy*2+2*$pad+$total_len/$bp_perpixel
#    foreach (sort{only_nums($a,0)<=> only_nums($b,0) } keys %name ) {
#      next if (/consensus/i && !$print_consensus);
#        $img->bgcolor( $marker_color{$_} );
#        $img->rectangle($start_x1,$start_y1,$start_x1+$thickness,$start_y1+$thickness);
#        $img->moveTo($start_x1+$thickness+$fontsize,$start_y1+$thickness);
#        $img->font('Times:italic');
#        $img->fontsize($fontsize);
#        $img->angle(0);
#        $img->string( $name{$_} );
#        $shift=$longest_chrname*$fontsize;
#        $start_x1 += $shift+$thickness+10,
#        $legend_count++;
#
#        ### start on new line if legend is going out of the image boundry..
#        if ($start_x1 > $img_width - $pad - $fontsize*length($name{$_})){
#        $start_y1 += $thickness + $fontsize;
#        $start_x1=$coords{$sample_names[0]}{$chr_names[$#chr_names]}{'x1'};
#        $start_x1=$coords{$sample_names[$#sample_names]}{$chr_names[0]}{'x1'} if $invert_axis;
#        }
#
#
#    }
#        $start_y1 += $thickness + $fontsize;
#        $start_x1=$coords{$sample_names[0]}{$chr_names[scalar@chr_names -1]}{'x1'};
#        $start_x1=$coords{$sample_names[$#sample_names]}{$chr_names[0]}{'x1'} if $invert_axis;
#
#
#}
##############################################################################################################
### add markers on each chromosomes.
my$output_file=$out_file?$out_file:join(".",$blastfile,$color_by_type_allele?"cbta":"cbna",$mar_list?"$mar_list.png":"png");
open OUT,">$output_file.Allele.density.table" if $print_allele_density;
print OUT "SampleName\tMarker\tChromosome\tChrLoation\tNumAllele" if $print_allele_density;;

foreach my$sample(keys %haplos){
   foreach my$markers(keys %{$haplos{$sample}}){

      next if ($mar_list && !defined $mar_list{$markers});

      #### FILTER MARKER
      #next if !exists $haplos{$sample}{$markers}{'allele'};
      #next if $haplos{$sample}{$markers}{'allele'} =~ /\-|^\s*$/;
      #next if !exists $chrlocs{$markers}{'chr'};
      #next if !exists $chrlocs{$markers}{'loc'};
      #next if ($haplos{$sample}{$markers}{'allele'} =~ /consensus/i && !$print_consensus);
      #

      next if !defined $allowed_samples{$sample};
      next if !defined $allowed_chrs{$chrlocs{$markers}{'chr'}};
      print "\nMarker Chrs:$chrlocs{$markers}{'chr'}:Allowed Chrs:$allowed_chrs{$chrlocs{$markers}{'chr'}}";

      ### filter if num_allele is not in allowed range.
      my$num_allele=$haplos{$sample}{$markers}{'allele'}=~s/\//\//g;
      my$color_index=$num_allele;
      next if ($num_allele+1 < $min_num_allele || $num_allele+1 > $max_num_allele);

      #### calculate coordinates of markers.
      
      my$m_chr=$chrlocs{$markers}{'chr'};
      my$m_loc=$chrlocs{$markers}{'loc'};
      while(exists $label_info{$m_chr}{$m_loc}) {$m_loc+=1}  ## to avoid loosing markers with exact same location, change location by 1
      my$m_color=$chrlocs{$markers}{'color'};
      my$m_loc_on_chr_in_pixel=$m_loc/$bp_perpixel;
      my$m_x1=$coords{$sample}{$m_chr}{'x1'};
      my$m_y1=$coords{$sample}{$m_chr}{'y1'}+$m_loc_on_chr_in_pixel;
      while(exists $label_info{$m_chr}{$m_loc}) {$m_loc=+1}
      
      $label_info{$m_chr}{$m_loc}{'x'}=$m_x1;
      $label_info{$m_chr}{$m_loc}{'y'}=$m_y1;
      $label_info{$m_chr}{$m_loc}{'mx'}=$m_x1;
      $label_info{$m_chr}{$m_loc}{'my'}=$m_y1;
      $label_info{$m_chr}{$m_loc}{'mname'}=$markers;
      $label_info{$m_chr}{$m_loc}{'mcolor'}=$m_color;
      #my$m_x2=$coords{$sample}{$m_chr}{'x2'};
      #my$m_y2=$coords{$sample}{$m_chr}{'y2'};


      #### define colors of markers.
      #my$color_index='red' if $haplos{$sample}{$markers}{'allele'} =~ /consensus/i;
      #$color_index='consensus' if $haplos{$sample}{$markers}{'allele'} =~ /consensus/i;
      print OUT "\n$sample\t$markers\t$m_chr\t$m_loc\t",$num_allele+1, if $print_allele_density;

      #### add markers
      my$marker_color=defined $marker_color{$color_index}?$marker_color{$color_index}:$colors[$#colors];
        #$marker_color=$haplos{$sample}{$markers}{'color'} if $color_by_type_allele;
        $marker_color=$mar_list{$markers} if ($use_list_color && $mar_list && $mar_list{$markers} !~ /none/i);
        #$marker_color=$img->alphaColor($marker_color,$alpha); ##creates only light blue.
         $marker_color=$marker_color?$marker_color:'black';
        next if ($max_only && max_allele_exists($color_index,$m_x1,$m_y1,$marker_height,\%drawing_coord));

        print "\nAdding marker color:$marker_color\tNumAllele:$color_index\tAllele:$haplos{$sample}{$markers}{'allele'}";
        my$marker_label=$label_marker?$markers:undef;
        $marker_color=$m_color?$m_color:$marker_color if $label_marker;
        AddMarkersToChr(\$img,$m_x1,$m_y1,$marker_width,$marker_height,$marker_color,$marker_shape,$marker_label);
        ## collect label infor to print later
         
   }
}

######## add marker labels if asked by user.
if ($label_marker) {
   my $mdist=$label_overlap;
   
   ## checlk if there is any over lap between markers.
   foreach my$mchr(%label_info){
         my @mlocs=( sort {$a <=> $b} keys %{$label_info{$mchr}} );
         my $num_loc=scalar@mlocs;
         for(my$i=0;$i < scalar@mlocs;$i++){
            next if ($i < 0 || $i >= scalar @mlocs - 1);
            if (label_too_close($label_info{$mchr}{$mlocs[$i]}{'my'},$label_info{$mchr}{$mlocs[$i+1]}{'my'},$mdist)){
               
               print "\n$mchr $i/$num_loc :Labels at $label_info{$mchr}{$mlocs[$i]}{'my'} is too close to $label_info{$mchr}{$mlocs[$i+1]}{'my'}\n*****Changed the coord of label from $label_info{$mchr}{$mlocs[$i]}{'my'}";
               
               $label_info{$mchr}{$mlocs[$i]}{'my'} = $label_info{$mchr}{$mlocs[$i]}{'my'} - $mdist;
               print " to $label_info{$mchr}{$mlocs[$i]}{'my'}. Restarting the comparison\n";
               $i = -1; ## Restart the comparison
               
               
            
            }else{
               print "\n$i/$num_loc: Markers look OK. Moving to next.";next}
         }
         
         #$label_info{$mchr}{$m_loc}{$markers}{'x'}=$m_x1;
   }
   my$marker_color='black';
   foreach my$mchr(%label_info){
      my @mlocs=(sort {$a <=> $b} keys %{$label_info{$mchr}});
         #my$mcolor=$label_info{$mchr}{$mlocs}{'mcolor'}?$label_info{$mchr}{$mlocs}{'mcolor'}:'black';
         for(my$i=0;$i<scalar@mlocs;$i++){
                  $marker_color=$label_info{$mchr}{$mlocs[$i]}{'mcolor'}?$label_info{$mchr}{$mlocs[$i]}{'mcolor'}:'black';
	          add_m_label(
                        \$img,
                        $label_info{$mchr}{$mlocs[$i]}{'x'},
                        $label_info{$mchr}{$mlocs[$i]}{'y'},
                        $label_info{$mchr}{$mlocs[$i]}{'mx'},
                        $label_info{$mchr}{$mlocs[$i]}{'my'},
                        $label_info{$mchr}{$mlocs[$i]}{'mname'},
                        $marker_width,
                        $marker_color,
                        $marker_height,
                        $label_dist
                        );
         }
         
         #$label_info{$mchr}{$m_loc}{$markers}{'x'}=$m_x1;
   }
   
}









#######################################################################################
####### mark regions on the chromosomes if asked by user.
if ($add_line_chr && $add_line_samp && $add_line_start &&$add_line_end) {


   my$x1=$coords{$add_line_samp}{$add_line_chr}{'x1'} - ($window_W -$thickness)/4;
   my$y1=$coords{$add_line_samp}{$add_line_chr}{'y1'} + $add_line_start/$bp_perpixel;

   my$x2=$x1+$thickness+($window_W -$thickness)/2;
   my$y2=$y1+ (($add_line_end - $add_line_start)/$bp_perpixel);

   # draw an empty rectangle with green borders
    $img->penSize(3,3);
    $img->bgcolor(undef);
    $img->fgcolor('green');
    $img->rectangle($x1,$y1,$x2,$y2);

   #mark_chrs(\$img,$x1,$y1,$marker_width,$marker_height,$marker_color,$marker_shape);

}






    # create a new image
    #my$img = GD::Simple->new(1200,800);
    #Add_chromosome(\$img,300,100,320,750,'blue');
    #AddMarkersToChr(\$img,310,400,10,'red','circle');
    #AddMarkersToChr(\$img,310,450,10,'green','line');
    #


# print the image out as jpeg and png files.
# convert into png data


open OUT2, ">$output_file";
binmode OUT2;
print OUT2 $img->png;
close OUT2;

print "\nSaved image as $output_file\n\n";
exit;
###########################################################
## builds a rounded filled rectangle by the coordinates of the left upper ,
## copied from : http://ysgitdiary.blogspot.com/2012/07/how-to-draw-rounded-corner-rectangle.html
## righ down corner , radius and color object

sub Add_chromosome {
   my $refObjImg = shift ;
   my $x1 = shift ;
   my $y1 = shift ;
   my $x2 = shift ;
   my $y2 = shift ;
   my $bgColor = shift;
   my $fgColor=shift;
   my $centromere=shift;

  ## put centromere in the middle if not defined.
   $fgColor=$fgColor?$fgColor:"black";
   $centromere=$centromere?$centromere:0;
   $$refObjImg->bgcolor("$bgColor");
   $$refObjImg->fgcolor("$fgColor");

  #my$radius=($x2-$x1)/2;
   #my$y3=$centromere+$radius/4;
  # my$y4=$centromere-$radius/4;


if($centromere == 0){
   rectangle_round_corners($refObjImg,$x1,$y1,$x2,$y2,$bgColor,$fgColor);
}
else{
   my$y3=$y1+$centromere;
   rectangle_round_corners($refObjImg,$x1,$y1,$x2,$y3,$bgColor,$fgColor);
   rectangle_round_corners($refObjImg,$x1,$y3,$x2,$y2,$bgColor,$fgColor);
   #print "\nDrawing chromosome at : $x1,$y1,$x2,$y3\tand \t$x1,$y3,$x2,$y2\tCentro at $centromere"
}

}

sub rectangle_round_corners{
   my $refObjImg = shift ;
   my $x1 = shift ;
   my $y1 = shift ;
   my $x2 = shift ;
   my $y2 = shift ;
   my $bgColor = shift;
   my $fgColor=shift;

  ## put centromere in the middle if not defined.
   $fgColor=$fgColor?$fgColor:"black";
   $$refObjImg->bgcolor("$bgColor");
   $$refObjImg->fgcolor("$fgColor");

   my$radius=($x2-$x1)/2;


   ##### build boundry of the chromosome (a larger rectangles in bg color.)
   my$diameter = $radius*2;

   $$refObjImg ->filledArc( $x1+$radius, $y1+$radius, $diameter+1, $diameter+1, 0 , 360 ,   $$refObjImg->fgcolor,gdArc);
   $$refObjImg ->filledArc( $x1+$radius, $y1+$radius, $diameter, $diameter, 0 , 360 ,   $$refObjImg->bgcolor,gdArc);

   $$refObjImg ->filledArc( $x1+$radius, $y2-$radius, $diameter+1, $diameter+1, 0 , 180 ,  $$refObjImg->fgcolor,gdArc);
   $$refObjImg ->filledArc( $x1+$radius, $y2-$radius, $diameter, $diameter, 0 , 180 ,  $$refObjImg->bgcolor,gdArc);

   $$refObjImg->filledRectangle ( $x1-1 , $y1+ $radius-1 , $x2+1 , $y2+1 - $radius ,  $$refObjImg->fgcolor);
   $$refObjImg->filledRectangle ( $x1 , $y1+ $radius -1 , $x2 , $y2 - $radius + 1 ,  $$refObjImg->bgcolor);

}




###########################################################
## builds a rounded filled rectangle by the coordinates of the left upper ,
## copied from : http://ysgitdiary.blogspot.com/2012/07/how-to-draw-rounded-corner-rectangle.html
## righ down corner , radius and color object

sub AddMarkersToChr {
   my $refObjImg = shift ;
   my $x1 = shift ;
   my $y1 = shift ;
   my $width=shift;
   my $height=shift;
   my $objColor = shift ;
   my $shape=shift;
   my $objName = shift;


  $shape=$shape?$shape:'line';
  #$objColor=[255,0,0];
if ($shape=~/line/i) {
    $$refObjImg->bgcolor($objColor);
    $$refObjImg->fgcolor($objColor);
    $$refObjImg->penSize($height,$height);
    $$refObjImg->moveTo($x1,$y1);
    $$refObjImg->lineTo($x1+$width,$y1);
}
elsif ($shape=~/circle|ellipse/i) {
    $$refObjImg->bgcolor($objColor);
    $$refObjImg->fgcolor($objColor);
    $$refObjImg->moveTo($x1+$width/2,$y1-$height/2);
    ###$img->ellipse($width,$height)
    $$refObjImg->ellipse($width,$height);

}

#if ($objName) {
#    $$refObjImg->bgcolor($objColor);
#    $$refObjImg->fgcolor($objColor);
#    $$refObjImg->penSize($height,$height);
#    
#    $$refObjImg->moveTo($x1+$width,$y1);
#    $$refObjImg->lineTo($x1+$width+$width,$y1);
#    $$refObjImg->font('Times:italic');
#    $$refObjImg->fontsize($fontsize);
#    $$refObjImg->angle(0);
#    $$refObjImg->string( $objName );
#    
#    
#    
#    
#}

print "\nAdded marker $objName in sub";

}


sub label_too_close{
   my $tloc1=shift;
   my $tloc2=shift;
   my $ldist=shift;
   
   return 0 if ( $tloc1=~m/^\s*$/ || $tloc2=~m/^\s*$/);
   my $vdist=$tloc2 - $tloc1;
   
   if ($vdist < $ldist) {
      print "\n***Labels at $tloc1 and $tloc2 overlap by $ldist\n";
      return 1;
   }else{
      return 0;
   }
   
   
}

#### find non-overlapping coordinate for labels.
sub add_m_label{
   my $refObjImg = shift ;
   my $x1 = shift ;
   my $y1 = shift ;
   my $mx1= shift;
   my $my1= shift;
   my $objName = shift;
   my $width = shift;
   my $objColor = shift;
   my $height = shift;
  my  $label_dist_from_chr=shift;

   print "\n FromSub: Adding label $objColor at X:$x1,$my1";

                        #
                        #\$img,
                        #$label_info{$mchr}{$mlocs[$i]}{'x'},
                        #$label_info{$mchr}{$mlocs[$i]}{'y'},
                        #$marker_width,$label_info{$mchr}{$mlocs[$i]}{'mx'},
                        #$marker_width,$label_info{$mchr}{$mlocs[$i]}{'my'},
                        #$marker_width,$label_info{$mchr}{$mlocs[$i]}{'mname'},
                        #$marker_width,
                        #$marker_color,
                        #$marker_height


   return if (!$x1 || !$y1);
   $objColor||='black';
   $height||=3;
   $width||=3;
   
   
   
   if ($objName !~ m/^\s*$/) {
    $$refObjImg->bgcolor($objColor);
    $$refObjImg->fgcolor($objColor);
    $$refObjImg->penSize($height,$height);
    
    $$refObjImg->moveTo($x1+$width,$y1);
    $$refObjImg->lineTo($x1+$width+$label_dist_from_chr,$my1);
    $$refObjImg->font('Times:italic');
    $$refObjImg->fontsize($fontsize);
    $$refObjImg->angle(0);
    $$refObjImg->string( $objName );
   }
   
   
   
   
   
}


#### strip non_numbers
sub only_nums
   { my $string=shift;
    my $return_if_non_num=shift;
    $string=~s/\D+//g; # expand all numbers to 4 digits
   return $return_if_non_num if length$string<1;
   return $string;
}


sub max_allele_exists{
   my$num_allele=shift;
   my$x1=shift;
   my$y1=shift;
   my$marker_height=shift;
   my$refHash_coord=shift;
   my$status=0 ;
   my$area_allele=0;


   ### test if area around the coordinate has any other marker.
   for ($y1 .. $y1+$marker_height){
      next if !defined $$refHash_coord{$x1}{$_};
      $area_allele=$$refHash_coord{$x1}{$_} if $$refHash_coord{$x1}{$_} > $area_allele;
      #last if $area_allele >0;
   }

   if ($area_allele>$num_allele) {
      $status=1;
   }else{
         for ($y1 .. $y1+$marker_height){
            $$refHash_coord{$x1}{$_}=$num_allele;
         }
         $status=0;
   }
   return($status);

}


#### sends rgb value is anonymous hash of the fraction of the gradient between two colors provided
sub create_gradient{
   my$fraction_from_gradient=shift;
   my$r1=shift;
   my$g1=shift;
   my$b1=shift;
   my$r2=shift;
   my$g2=shift;
   my$b2=shift;


   my$mr=255;
   my$mg=255;
   my$mb=255;

    $fraction_from_gradient*=2;
    $fraction_from_gradient = 0 if $fraction_from_gradient/2 <   0;
    $fraction_from_gradient = 1 if $fraction_from_gradient/2 > 1;
    my$r=my$g=my$b=0;

   if ($fraction_from_gradient/2 <0.5) {

         $r = $r1+$fraction_from_gradient*($mr-$r1);
         $g = $g1+$fraction_from_gradient*($mg-$g1);
         $b = $b1+$fraction_from_gradient*($mb-$b1);

   }else{

         $r = $mr-(($fraction_from_gradient*abs($r2-$mr))/2);
         $g = $mg-(($fraction_from_gradient*abs($g2-$mg))/2);
         $b = $mb-(($fraction_from_gradient*abs($b2-$mb))/2);
   }

    return [int$r,int$g,int$b]
}