#!/usr/local/bin/perl

package mapview;

use strict;
use SiteDefs;
use EnsWeb;
use CGI qw/:standard :form :netscape3/;

use Bio::EnsEMBL::Map::DBSQL::Map;
use Bio::EnsEMBL::Map::DBSQL::Obj;
use Bio::EnsEMBL::DBSQL::DBAdaptor;
use Bio::EnsEMBL::DBSQL::ChromosomeStatsAdaptor;
use Bio::EnsemblViewer::JSTools;
use Bio::EnsemblViewer::MapDB;
use Bio::EnsemblViewer::DensityPlot::DensityAdaptor;
use Bio::EnsemblViewer::DensityPlot::Plot;

use HelpView;
use GD;

my $q = new CGI;
my $db= undef;
my $ensembl_db;
my $obj = undef;
my $kobj = undef;
my $marker= undef;
my $map = undef;
my $chr=undef;
my $gif = undef;
my $FISH_range=0;
my $rhrange=undef;
my $discrepancy;
my $mapdb = undef;
my $ensdb = undef;
my $searchmarker;
my $fpccontig;
my $img_type;

if (GD::Image->can("gif")){
    $img_type = "gif";
}
else {
    $img_type = "png";
}

if (scalar ($q->param) < 1){
    $q->param(-name=>'chr',-value=>'1');
}

$marker         = $q->param('marker');
$fpccontig      = $q->param('fpc');
$map            = $q->param('map');
$searchmarker   = $q->param('searchmarker');
$searchmarker   = uc($searchmarker) if $searchmarker;


###############
# Print Header
###############
if( defined( $ENV{'MOD_PERL'} ) )
{
  my $r = Apache->request();
  print header();
  $r->err_header_out('ensembl_headers_out'=>1);
  print EnsWeb::make_cgi_header(('initfocus'=>1, 'menus'=>1));
  print EnsWeb::print_form($marker, "marker");
}
eval{  
    $db   = new Bio::EnsEMBL::Map::DBSQL::Obj(  
                                            -user   => $ENSEMBL_DBUSER, 
                                            -dbname => $ENSEMBL_MAP,
                                            -host   => $ENSEMBL_HOST,
                                            -port   => $ENSEMBL_HOST_PORT,
                                            -ensdb  => $ENSEMBL_DB,
                                            );
};

if( $@ ) {
    print &ensembl_exception("Sorry, the Ensembl map database is currently unavailable.",$@);
    &ensembl_exit;
}

eval {
    my $locator = &EnsWeb::get_locator();
    $ensembl_db =  Bio::EnsEMBL::DBLoader->new($locator);
};


if( $@ ) {
    print &ensembl_exception("Sorry, the Ensembl database is currently unavailable.",$@);
    &ensembl_exit;
}

if (defined $searchmarker || $searchmarker ne ""){
    eval{
        my $mr = $db->get_Marker_Synonym($searchmarker);
        $marker = $mr->[0]->id;
        if ($marker){
            foreach my $mrrk (@{$mr->[0]->maps}){
                unless ($mrrk->id eq 'FISH'){ $map=$mrrk->id;}
            }
            if ($map){
                $chr = $mr->[0]->chromosomeMaps->[0]->name;
            }
        }
    };
    if( $@ ) {
	print &ensembl_exception("The marker $searchmarker cannot be found.",$@);
	&ensembl_exit;
    }

    unless ($marker && $map && $chr){
	print &ensembl_exception("The marker $searchmarker has not been located to a map, and so cannot be viewed in MapView. Sorry!",$@,1);
        eval '$db->deleteObj';
	&ensembl_exit;
    }
}


if (! defined $map){
    $map='GB4';
}

if (! defined $marker){
    $marker=undef;
}

$discrepancy = $q->param('discrepancy');
if (! defined $discrepancy){
    $discrepancy=0;
}

if (! defined $chr ){
    $chr = uc($q->param('chr'));
    if (! defined $chr){
        $chr='1';
    }
}

$chr =~ s/\W//;

$chr='X' if $chr == 23;
$chr='Y' if $chr == 24;

$rhrange = $q->param('rhrange');
if (! defined $rhrange){
    $rhrange=0;
}


if ($chr =~/\d/ && $chr < 1 || $chr > 22){
    print &ensembl_exception("Sorry, Invalid chromosome. Please select a different chromosome","",1);
    eval '$db->deleteObj';
    &ensembl_exit;
}

#######################################################################
# Draw the main map
######################################################################
my $image_param=  {
        x_img_len       => 100,
        y_img_len       => 500,
        left_margin     => 0,
        right_margin    => 20,
        top_margin      => 10,
        bottom_margin   => 10, 
    };

eval{
   $mapdb=MapDB->new($db,$ensembl_db,$image_param);
};

if( $@ ) {
    print &ensembl_exception("Error creating map database object.",$@);
    eval '$db->deleteObj';
    &ensembl_exit;
}

my $map_param = {
        FISH_range   => $FISH_range,  
        RH_range     => $rhrange,
        chromosome   => $chr,
        marker       => $marker,
        marker_color => 'deep_pink',
        marker_set   => 40,
        "map"        => $map,
};

eval{
    $obj = $mapdb->integrated_map($map_param);
};
if( $@ ) {
    print &ensembl_exception("Integrated map exception.",$@);
    eval '$db->deleteObj';
    &ensembl_exit;
}

my %menuopts_rhmarker = (
    'caption'                  => 'menu caption',
#    'View sequence info'       => '/perl/contigview?fpc=',
    'RH marker info'           => '/perl/markerview?seqentry=',
);

my %menuopts_fishmarker = (
    'caption'                  => 'menu caption',
    'Focus map on this marker' => "/perl/mapview?discrepancy=$discrepancy&chr=$chr&marker=",
#   'RH marker info'           => '/perl/markerview?seqentry=',
);

my %menuopts_fpcmap = (
    'caption'                  => 'menu caption',
    'View sequence'            => "/perl/contigview?clone=",
);

my %menuopts_rhmap = (
    'caption'                  => 'menu caption',
    'Focus map on this interval' => "/perl/mapview?discrepancy=$discrepancy&chr=$chr&rhrange=",
);


# fix brain-dead macs
if ($ENV{'NO_JS_MENUS'}){
    $menuopts_rhmarker{'mac'}       = '/perl/markerview?seqentry=';
    $menuopts_fishmarker{'mac'}     = "/perl/mapview?discrepancy=$discrepancy&chr=$chr&marker=";
    $menuopts_fpcmap{'mac'}         = "/perl/contigview?clone=";
    $menuopts_rhmap{'mac'}          = "/perl/mapview?discrepancy=$discrepancy&chr=$chr&rhrange=";
}

$obj->set_RHmarkers_url(\%menuopts_rhmarker);
$obj->set_FISHmarkers_url(\%menuopts_fishmarker);
$obj->set_RHmap_url(\%menuopts_rhmap);
$obj->set_FPCmap_url(\%menuopts_fpcmap);

$obj->set_FPCcontig($fpccontig);
$obj->set_FPCcontig_color('deep_pink');
$obj->set_all_contigs_color("fire_brick");

eval{
    $obj->set_discrepancy_level($discrepancy);
    $obj->all_maps;
};
if( $@ ) {
    print &ensembl_exception("All map exception.",$@);
    eval '$db->deleteObj';
    &ensembl_exit;
}

eval {
    my $coord = $obj->y_coord_ext;
};
if( $@ ) {
    print &ensembl_exception("Coord map exception.",$@);
    eval '$db->deleteObj';
    &ensembl_exit;
}

print<<EOS;
    <MAP Name="Chr${chr}Map">
EOS

$gif=$obj->get_GIF(\*STDOUT);
print   "</map>\n";


my ($html_options, $html_map, $html_threshold);

####################################
# print out the select OPTION lines
####################################
foreach my $option (qw(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 X Y)){
    $html_options .= qq(<option value="$option");
    if ($option eq $chr){$html_options .= qq( selected )};
    $html_options .= qq(>$option</option>\n);
}

#########################
# Save off the map image
#########################
open(GIF,">$ENSEMBL_SERVERROOT/htdocs/gfx/clone/chr$chr.mk$marker.$rhrange.$map.$discrepancy.$img_type") or die "Cannot create $img_type of map: $!\n";
print GIF $gif;
close(GIF);

###############################
# Get the feature density plot
###############################

my ($fd_img,$dist_img_map) = &get_feature_density_img($image_param,$chr);
open(IMG,">$ENSEMBL_SERVERROOT/htdocs/gfx/clone/chr$chr.mk$marker.$rhrange.$map.$discrepancy.dens.$img_type") or die "Cannot create $img_type of density: $!\n";
print IMG $fd_img;
close(IMG);

my $dist_img_map_link="";

if ($dist_img_map){
    print qq(<map name="Dist${chr}Map">\n);    
    print $dist_img_map;
    print qq(</map>);
    $dist_img_map_link=qq(USEMAP="#Dist${chr}Map");
}

open(GIF,"<$ENSEMBL_SERVERROOT/htdocs/gfx/clone/chr$chr.mk$marker.$rhrange.$map.$discrepancy.$img_type") or die "Cannot create $img_type of map: $!\n";

my $image;
if (GD::Image->can("newFromGif")){
    $image = GD::Image->newFromGif(\*GIF) || die "Can't reopen maps gif";
}
else {
    $image = GD::Image->newFromPng(\*GIF) || die "Can't reopen maps png";
}
close GIF;

my ($image_width,$image_height)=$image->getBounds;

# Clean up edge of original map
my $yellow1 = $image->colorAllocate( 255, 255, 231 );
$image->line(0,1,0,$image_height-2, $yellow1);

open(GIF,">$ENSEMBL_SERVERROOT/htdocs/gfx/clone/chr$chr.mk$marker.$rhrange.$map.$discrepancy.$img_type") or die "Cannot create $img_type of map: $!\n";
if (GD::Image->can("gif")){
    print GIF $image->gif;
}
else {
    print GIF $image->png;
}
close(GIF);

###########################
# Get the chromosome stats
###########################
my $stats_adaptor = Bio::EnsEMBL::DBSQL::ChromosomeStatsAdaptor->new($ensembl_db);

my ($chr_known_genes,$chr_unknown_genes, $chr_snps, $chr_length);
$chr=23 if $chr eq "X";
$chr=24 if $chr eq "Y";
foreach my $stats($stats_adaptor->get_stats_per_chromosome($chr)){
    $chr_known_genes = $stats->known_genes || "unknown";
    $chr_unknown_genes = $stats->unknown_genes || "unknown";
    $chr_snps = $stats->snps || "unknown";
    $chr_length = $stats->length || "unknown";
}
$chr="X" if $chr == 23;
$chr="Y" if $chr == 24;

##################
# Get the Markers
##################

my @markers;

eval{  
    my $db   = new Bio::EnsEMBL::DBSQL::DBAdaptor(  
					    -user   => $ENSEMBL_DBUSER, 
					    -dbname => $ENSEMBL_DB,
					    -host   => $ENSEMBL_HOST,
					    -port   => $ENSEMBL_HOST_PORT,
					    );

    my $chrobj = $db->get_ChromosomeAdaptor->fetch_by_chrname("chr$chr");
    @markers = $chrobj->get_landmark_MarkerFeatures;
};

if ($@){
    print &ensembl_exception("Cannot retrieve Chromosome $chr object.",$@);
    &ensembl_exit;
}

my $markers_start;
my $markers_end;

foreach my $markersf (@markers){
    my $id = $markersf->id;
    my $start = bp_to_nearest_unit($markersf->start);
    my $context_start = $markersf->start - 100000;
    my $end = bp_to_nearest_unit($markersf->end);
    my $context_end = $markersf->end + 100000;
    $markers_start .= qq(<option value="$context_start">$id (at $start)</option>);
    $markers_end .= qq(<option value="$context_end">$id (at $start)</option>);
}


#####################
# Print out the page
#####################
my $THIS = $ENV{'SCRIPT_NAME'};
$THIS =~ s/^.*\/(.*?)$/$1/;
my $help_link = &HelpView::helplink("mapview_options");

print<<EOS;
<br>
<TABLE cellpadding="0" cellspacing="0" border="0">
  <TR valign="top">
    <TD nowrap align="center">
      <!-- begin distribution img -->
      <IMG SRC="/gfx/clone/chr$chr.mk$marker.$rhrange.$map.$discrepancy.dens.$img_type" BORDER="0" $dist_img_map_link><IMG SRC="/gfx/clone/chr$chr.mk$marker.$rhrange.$map.$discrepancy.$img_type" BORDER="0" USEMAP="#Chr${chr}Map"><BR><br><br>
      <!-- end mapview img -->
    </td>
    <td><img src="/gfx/blank.gif" width="20" height="1" alt=""></td>
    <td>
      <table cellpadding="0" cellspacing="0" border="0">
        <tr valign="top">
          <td class="black" colspan="5"><img src="/gfx/blank.gif" width="10" height="1" alt=""></td>
        </tr>
        <tr class="yellow2">
          <td class="black" rowspan="11"><img src="/gfx/blank.gif" width="1" height="1" alt=""></td>
          <td><img src="/gfx/blank.gif" width="15" alt=""></td>
          <td align="center"><span class="h4">Chromosome $chr</span></td>
          <td><img src="/gfx/blank.gif" width="15" alt=""></td>
          <td class="black" rowspan="11"><img src="/gfx/blank.gif" width="1" height="1" alt=""></td>
        </tr>
        <tr align="center">
          <td class="yellow1"><img src="/gfx/blank.gif" width="15" alt=""></td>
          <td class="yellow1"><br>
	  <table cellpadding="0" cellspacing="0" border="0">
	    <tr class="yellow1">
	      <td><img src="/gfx/blank.gif" height = "1" width="1" alt=""></td>
	      <td><img src="/gfx/blank.gif" height = "1" width="15" alt=""></td>
	      <td><img src="/gfx/blank.gif" height = "1" width="1" alt=""></td>
	    </tr>
	    <tr valign="middle" class="yellow1">
	      <td><b>Known Ensembl Genes:</b> $chr_known_genes</td>
	      <td><img src="/gfx/blank.gif" width="15" alt=""></td>
	      <td><b>SNPs:</b> $chr_snps</td>
	    </tr>
	    <tr valign="middle" class="yellow1">
	      <td nowrap><b>Novel Ensembl Genes:</b> $chr_unknown_genes</td>
	      <td><img src="/gfx/blank.gif" width="15" alt=""></td>
	      <td nowrap><b>Length:</b> $chr_length bp</td>
	    </tr>
	  </table></td>
          <td class="yellow1"><img src="/gfx/blank.gif" width="15" alt=""></td>
	</tr>
	<tr>
          <td class="yellow1" colspan="3"><img src="/gfx/blank.gif" width="15" alt=""></td>
	</tr>
        <tr class="yellow2">
          <td><img src="/gfx/blank.gif" width="15" alt=""></td>
          <td align="center"><span class="h4">Change Chromosome</span></td>
          <td><img src="/gfx/blank.gif" width="15" alt=""></td>
        </tr>
        <tr align="center">
            <td class="yellow1"><img src="/gfx/blank.gif" width="15" alt=""></td>
            <form action="/perl/mapview" method="GET" name="chromosome">
            <td class="yellow1"><br>
		<table cellspacing="0" cellpadding="0" border="0">
		  <tr>
		    <td>Chromosome: </td>
		    <td><select name="chr" onChange='javascript:location="/perl/mapview?chr="+this.options[this.selectedIndex].value;'>$html_options</select></td>
		    <td> <INPUT TYPE="image" VALUE="lookup" class="red2" src="/gfx/lookup.gif" border="0" valign="middle"></td>
		  </tr>
	    	</table>
		<br></td></form>
            <td class="yellow1"><img src="/gfx/blank.gif" width="15" alt=""></td>
	</tr>
        <tr class="yellow2">
          <td><img src="/gfx/blank.gif" width="15" alt=""></td>
          <td align="center"><span class="h4">Jump to Contigview</span></td>
          <td><img src="/gfx/blank.gif" width="15" alt=""></td>
        </tr>
        <tr align="center">
            <td class="yellow1"><img src="/gfx/blank.gif" width="15" alt=""></td>
            <td class="yellow1"><br>Click anywhere on the chromosome ideogram or one of the feature distribution plots to jump to a contig-level view of features at that point.<br><br>Alternatively, you can jump to contigview between any two landmark markers on this chromosome:
            <form action="/perl/contigview" method="GET">
	    <table align="center" cellpadding="0" cellspacing="5" border="0">
		<tr><input type="hidden" name="chr" value="$chr">
		    <td>Between: </td>
		    <td><select name="vc_start">$markers_start</select></td>
		</tr>
		<tr>
		    <td>and: </td>
		    <td><select name="vc_end">$markers_end</select></td>
		</tr>
		<tr>
		    <td align="center" colspan="2"><INPUT TYPE="image" VALUE="lookup" class="red2" src="/gfx/lookup.gif" border="0"></form></td>
		</tr>
		</table></td>
            <td class="yellow1"><img src="/gfx/blank.gif" width="15" alt=""></td>
	</tr>
        <tr class="yellow2">
          <td><img src="/gfx/blank.gif" width="15" alt=""></td>
          <td align="center"><span class="h4">OMIM Diseases</span></td>
          <td><img src="/gfx/blank.gif" width="15" alt=""></td>
        </tr>
        <tr class="yellow1">
            <td><img src="/gfx/blank.gif" width="15" alt=""></td>
            <td align="center"><br><a href="/perl/diseaseview?chr=$chr">Browse OMIM Diseases</a> on this chromosome.<br><br></td>
            <td><img src="/gfx/blank.gif" width="15" alt=""></td>
	</tr>
        <tr valign="top">
          <td class="black" colspan="5"><img src="/gfx/blank.gif" width="1" height="1" alt=""></td>
        </tr>
      </table>
      <!-- end rhs info -->
    </td>
  </tr>
</table>
<BR>
EOS
  
$rhrange=undef;
eval '$db->deleteObj';

print EnsWeb::make_cgi_footer();

Apache::exit;

###############################################################################
###############################################################################
###############################################################################

###############################################################################
# get_feature_density_img - calls all the density drawing stuff, and returns a
#   single gif for saving, and an image map if one is created.
###############################################################################
sub get_feature_density_img {
    my ($image_param_ref,$chr) = @_;

    $chr=23 if $chr eq 'X';
    $chr=24 if $chr eq 'Y';

    my %image_param = %$image_param_ref;

    my $da;

    eval{  
	my $db   = new Bio::EnsEMBL::DBSQL::DBAdaptor(  
						-user   => $ENSEMBL_DBUSER, 
						-dbname => $ENSEMBL_DB,
						-host   => $ENSEMBL_HOST,
						-port   => $ENSEMBL_HOST_PORT,
						);

	$da= Bio::EnsemblViewer::DensityPlot::DensityAdaptor->new($db);
    };

    if( $@ ) {
	print &ensembl_exception("Cannot retrieve map density information.",$@);
	&ensembl_exit;
    }

    my $sv_kngene   = $da->get_density_per_chromosome_type($chr,'kngene');
    my $sv_gene	    = $da->get_density_per_chromosome_type($chr,'gene');
    my $sv_gc	    = $da->get_density_per_chromosome_type($chr,'gc');
    my $sv_repeat   = $da->get_density_per_chromosome_type($chr,'repeat');
    my $sv_snp	    = $da->get_density_per_chromosome_type($chr,'snp');
    my $sv_path	    = $da->get_density_per_chromosome_type($chr,'path');

    $sv_path->position('ALL');
    $sv_path->label();
    $sv_path->scale_to_fit(1);
    $sv_path->color();
    $sv_path->shape();

    $sv_kngene->position(1);
    $sv_kngene->label("Known Genes");
    $sv_kngene->scale_to_fit(60);
    $sv_kngene->color('rust');
    $sv_kngene->shape('filledrectangle');
    
    $sv_gene->position(1);
    $sv_gene->label2("Total Genes");
    $sv_gene->scale_to_fit(60);
    $sv_gene->color('black');
    $sv_gene->shape('rectangle');

    $sv_gc->position(2);
    $sv_gc->stretch(1);
    $sv_gc->label("% GC");
    $sv_gc->scale_to_fit(40);
    $sv_gc->color('red');
    $sv_gc->shape('wiggle');

    $sv_repeat->position(2);
    $sv_repeat->stretch(1);
    $sv_repeat->label2("Repeats");
    $sv_repeat->scale_to_fit(40);
    $sv_repeat->color('darkgreen');
    $sv_repeat->shape('line');

    $sv_snp->position(3);
    $sv_snp->label("SNPs");
    $sv_snp->scale_to_fit(40);
    $sv_snp->color('blue2');
    $sv_snp->shape('rectangle');

    # As they overlap, we must set the scaling value of kngene and gene to be
    # the same, and the biggest, absolute value.  The next line does this...
    $sv_kngene->_store_biggest($sv_gene->_store_biggest($sv_kngene->_store_biggest(0)));

    ######################################
    # Add URLs to plots to generate imgmap
    ######################################
    $chr='X' if $chr ==23;
    $chr='Y' if $chr ==24;

    my @bvset=$sv_path->get_binvalues; 
    foreach my $path_bv(@bvset){
	my $tmp_url = "/perl/contigview?chr=$chr&";
	my $tmp_start = $path_bv->chromosomestart;
	my $tmp_end = $path_bv->chromosomeend;

	# window 100 kbp around the centre
	my $start = int(($tmp_start+$tmp_end)/2)-50000;
	my $end   = $start + 100000;

	$tmp_url .= "vc_start=$start&vc_end=$end";
 
	$path_bv->url($tmp_url);
    }

    my $set = new Bio::EnsemblViewer::DensityPlot::Plot;
    $set->add_scaled_value_set($sv_kngene);
    $set->add_scaled_value_set($sv_gene);
    $set->add_scaled_value_set($sv_gc);
    $set->add_scaled_value_set($sv_repeat);
    $set->add_scaled_value_set($sv_snp);
    $set->add_scaled_value_set($sv_path);
    
    my $set_gif= $set->get_gif({'img_x'		=> undef,
				'img_y'		=> $image_param{'y_img_len'},
				'plot_length'   => 455,
				'left_margin'   => 20,
				'top_margin'    => 39,
				'label_y'	=> $image_param{'top_margin'},
				'label2_y'	=> 20,
				'plot_spacer'   => 25,
				});
    
    my @set_img_map = $set->get_img_map;
    
    my $img_map = join ("\n",@set_img_map);
    return ($set_gif,$img_map);
}

sub bp_to_nearest_unit {
    my ($bp,$dp) = @_;
    $dp = 2 unless defined $dp;
    
    my @units = qw( bp Kb Mb Gb Tb );
    
    my $power_ranger = int( ( length( abs($bp) ) - 1 ) / 3 );
    my $unit = $units[$power_ranger];
    my $unit_str;

    my $value = int( $bp / ( 10 ** ( $power_ranger * 3 ) ) );
      
    if ( $unit ne "bp" ){
	$unit_str = sprintf( "%.${dp}f%s", $bp / ( 10 ** ( $power_ranger * 3 ) ), " $unit" );
    }else{
	$unit_str = "$value $unit";
    }
    return $unit_str;
}

1;

#####################################################################
