lib/CXGN/Cview/Map_overviews/Generic.pm

   1
   2
   3
   4 =head1 NAME
   5
   6 CXGN::Cview::Map_overviews::Generic - a class to display generic genetic map overviews.
   7
   8 =head1 SYNOPSYS
   9
  10 see L<CXGN::Cview::Map_overviews>.
  11
  12 =head1 DESCRIPTION
  13
  14
  15 =head1 AUTHOR(S)
  16
  17 Lukas Mueller (lam87@cornell.edu)
  18
  19 =head1 VERSION
  20
  21
  22 =head1 LICENSE
  23
  24
  25 =head1 FUNCTIONS
  26
  27 This class implements the following functions:
  28
  29 =cut
  30
  31
  32
  33 use strict;
  34
  35 package CXGN::Cview::Map_overviews::Generic;
  36
  37 use CXGN::Cview::Map::Tools;
  38 use CXGN::Marker::Tools qw | clean_marker_name |;
  39
  40 use base qw ( CXGN::Cview::Map_overviews );
  41
  42
  43 =head2 function new()
  44
  45  Synopsis:      my $overview = CXGN::Cview::Map_overviews::generic_map_overview->new(CXGN::Cview::Map::SGN::Genetic->new(9));
  46  Arguments:     The a CXGN::Cview::Map object for the map to be displayed.
  47  Returns:       an overview object (constructor)
  48  Side effects:  sets up the overview object.
  49  Description:
  50
  51 =cut
  52
  53 sub new {
  54     my $class = shift;
  55     my $map = shift;
  56     my $force = shift;
  57
  58     my $self = $class -> SUPER::new($force);
  59
  60     if (!$map) { exit(); }
  61
  62     $self->set_map($map);
  63     return $self;
  64 }
  65
  66
  67 sub render {
  68     my $self = shift;
  69       my $map_width=$self->get_image_width();
  70     my $image_height = $self->get_image_height();
  71     my $top_margin = 40;
  72     $self->{map_image}= CXGN::Cview::MapImage->new("", $map_width, $image_height);
  73
  74     my @c = ();
  75 #    my $unit_eq = 0.4; # 1 cM corresponds to 0.4 pixels.
  76
  77     # determine the longest chromosome for proper scaling...
  78     #
  79     my @c_len = $self->get_map()->get_chromosome_lengths();
  80     #print STDERR "chromosome lengths: ".(join " ", @c_len)."\n";
  81     my $longest_length = 0; # zero based
  82     my $longest_chr = undef;
  83     if (!$self->get_map()->get_chromosome_count()) {
  84         die "This map does not seem to have any chromosomes...";
  85     }
  86     for (my $i=0; $i<$self->get_map()->get_chromosome_count(); $i++)  {
  87         if ($c_len[$i] >= $longest_length) {
  88             $longest_chr = $i;
  89             $longest_length = $c_len[$i];
  90         }
  91     }
  92
  93 #    my $longest_length = $c_len[$longest_chr];
  94  #   print STDERR "longest chromosome: $longest_length [$longest_chr]\n";
  95     my $unit_eq = ($image_height-2*$top_margin) /$longest_length;
  96  #   print STDERR "unit_eq = $unit_eq\n";
  97
  98 #    if ($self->get_map->get_type()=~ /seq/) { $unit_eq=2; }
  99
 100     my @clean_markers = ();
 101     foreach my $hm ($self->get_hilite_markers()) {
 102         my($clean, $suffix) = clean_marker_name($hm);
 103         push @clean_markers, $clean;
 104     }
 105     my $hilite_markers = join (" ", @clean_markers);
 106     my $hilite_markers_link = $hilite_markers;
 107     $hilite_markers_link =~ s/ /\+/g;
 108 #    my $max_chr_len_units = 0;
 109 #    my $max_chr_len_pixels = 0;
 110     my $chr_count = $self->get_map()->get_chromosome_count();
 111     my @chr_names = $self->get_map()->get_chromosome_names();
 112
 113     #print STDERR "chromosome names: ".(join " ", @chr_names)."\n";
 114     $self->set_horizontal_spacing(int(($map_width-40)/($chr_count)));
 115
 116     #print STDERR "chromosome count is $chr_count\n";
 117     my %marker_found = ();
 118
 119     for (my $i=$chr_count-1; $i>=0; $i--) {
 120
 121         #print STDERR "Instantiating chr $chr_names[$i]... in index $i\n";
 122
 123         $c[$i] = $self->get_map()->get_overview_chromosome($chr_names[$i]);
 124
 125         $c[$i]->set_horizontal_offset($self->get_horizontal_spacing()*($i)+35);
 126         $c[$i]->set_vertical_offset($top_margin);
 127
 128         $c[$i]->set_caption($chr_names[$i]);
 129
 130         my @markers = $c[$i]->get_markers();
 131
 132         my $chr_len = 0;
 133
 134         foreach my $m (@markers) {
 135
 136             $m -> set_color(200, 100, 100);
 137             if ($m->get_offset() > $chr_len) { $chr_len = $m->get_offset(); }
 138             #print STDERR "Read: ".$m->get_name." offset: ".$m->get_offset()."\n";
 139             my $marker_name_suffix = $m->get_marker_name();
 140             my $marker_name = $m->get_name();
 141             my $marker_id = $m->get_id();
 142             if (($hilite_markers =~ /\b($marker_name)\b|\b($marker_name_suffix)\b/i)) {
 143                 my $match = $1 || $2;
 144                 #print STDERR "MATCH:$match\n";
 145                 $marker_found{$match}=1;
 146                 $m->set_label_spacer(15);
 147                 $m->set_url("/search/markers/markerinfo.pl?marker_id=$marker_id");
 148                 $m->show_label();
 149                 $m->hilite();
 150             }
 151         }
 152
 153         $c[$i]->set_height($c_len[$i]*$unit_eq);
 154         $c[$i]->set_length($c_len[$i]);
 155         $c[$i]->layout();
 156         if ($self->get_map()->can_zoom()) {
 157             my $lg_name = $chr_names[$i];
 158             $c[$i]->rasterize(5);
 159             $c[$i]->set_rasterize_link("/cview/view_chromosome.pl?map_version_id=".$self->get_map()->get_id()."&amp;chr_nr=$lg_name&amp;show_offsets=1&amp;show_zoomed=1&amp;show_ruler=1&amp;hilite=$hilite_markers_link&amp;clicked=1&amp;cM=");
 160             warn " done!\n";
 161         }
 162         else {
 163             $c[$i]->set_url("/cview/view_chromosome.pl?map_version_id=".($self->get_map()->get_id())."&amp;chr_nr=$chr_names[$i]");
 164         }
 165         if ($c[$i]->get_scaling_factor() == 0) {
 166             die "Scaling factor is 0. How did this happen?";
 167         }
 168         $self->{map_image}->add_chromosome($c[$i]);
 169     }
 170 #    if (!$self->is_fish_map()) {
 171 #       my $ruler = CXGN::Cview::Ruler->new(20, $top_margin, $longest_length * $unit_eq, 0, $longest_length, $self->get_map()->get_units());
 172 #       $ruler ->set_units( $self->get_map()->get_units() );
 173 #       $self->{map_image}->add_ruler($ruler);
 174
 175 #}
 176     # get the ruler and add it to the image
 177     #
 178     #print STDERR "Setting up the ruler... longest chr is $longest_chr\n";
 179     my $ruler = $c[$longest_chr]->get_ruler();
 180     $ruler->set_vertical_offset($top_margin);
 181     $ruler->set_horizontal_offset(20);
 182     $ruler->set_units($self->get_map()->get_units());
 183     $ruler->set_start_value(0);
 184     $ruler->set_end_value( $c[$longest_chr]->get_length() );
 185     $ruler->set_height( $c[$longest_chr]->get_height() );
 186
 187
 188     $self->{map_image}->add_ruler($ruler);
 189
 190     #print STDERR "done.\n";
 191
 192     # hilite markers that were requested...
 193     #
 194     foreach my $hm (@clean_markers) {
 195         chomp($hm);
 196         if (!exists($marker_found{$hm})) {
 197             #print STDERR "Adding $hm to the list...\n";
 198             $self->add_marker_not_found($hm);
 199         }
 200     }
 201
 202     # add a legend if the map is F2-2000.
 203     #
 204     if (CXGN::Cview::Map::Tools::find_map_id_with_version($self, $self->get_map()->get_id()) == CXGN::Cview::Map::Tools::current_tomato_map_id()) {
 205
 206         #   $image->string($font,$x,$y,$string,$color)
 207         my $legend = CXGN::Cview::Label->new();
 208         $legend->set_name('Note: Positions of fully sequenced BACs are shown in yellow');
 209         $legend->set_vertical_offset($image_height-12);
 210         $legend->set_horizontal_offset(30);
 211         $legend->set_reference_point(30, $image_height-15);
 212
 213         $self->{map_image}->add_image_object($legend);
 214     }
 215     $self->set_chromosomes(\@c);
 216 }
 217
 218
 219
 220 sub render_map {
 221     my $self = shift;
 222
 223     # set up the cache
 224     $self->get_cache()->set_key($self->get_map()->get_id()."-".($self->get_image_height())."-".(join "-", ($self->get_hilite_markers())).__PACKAGE__ );
 225     $self->get_cache()->set_map_name("mapmap");
 226
 227     if ($self->get_cache()->is_valid())  {
 228         return;
 229     }
 230
 231     #print STDERR "Regenerating the map ".$self->get_map()->get_id()."\n";
 232     $self->render();
 233
 234     $self->get_cache()->set_image_data( $self->{map_image}->render_png_string());
 235     $self->get_cache()->set_image_map_data( $self->{map_image}->get_image_map("mapmap") );
 236
 237
 238 }
 239
 240 sub is_fish_map {
 241     my $self = shift;
 242     if ($self->get_map()->get_type() =~/fish/i) { return 1;    }
 243     else {
 244         return 0;
 245     }
 246 }
 247
 248
 249 =head2 function get_map
 250
 251  Synopsis:
 252  Arguments:
 253  Returns:       gets the map object to refer to.
 254  Side effects:
 255  Description:
 256
 257 =cut
 258
 259 sub get_map {
 260     my $self=shift;
 261     return $self->{map};
 262 }
 263
 264 =head2 function set_map
 265
 266  Synopsis:
 267  Arguments:     the map object to refer to
 268  Returns:       nothing
 269  Side effects:  the data about map object will be displayed
 270  Description:
 271
 272 =cut
 273
 274 sub set_map {
 275     my $self=shift;
 276     $self->{map}=shift;
 277 }
 278
 279 # no need to override this function here because the default
 280 # in the parent class are fine for our purposes.
 281 #
 282 # =head2 function get_cache_key
 283
 284 #   Synopsis:
 285 #   Arguments:
 286 #   Returns:
 287 #   Side effects:
 288 #   Description:
 289
 290 # =cut
 291
 292 # sub get_cache_key {
 293 #     my $self = shift;
 294 #     my $key =  $self->get_map()->map_id()."-".(join "-", ($self->get_hilite_markers())).__PACKAGE__;
 295 #     print STDERR "Setting cache key to : $key\n";
 296 #     return $key;
 297 # }
 298
 299
 300 # A deprecated package name.
 301 # but providing a compatibility layer...
 302 #
 303 package CXGN::Cview::Map_overviews::generic_map_overview;
 304
 305 use base qw | CXGN::Cview::Map_overviews::Generic | ;
 306
 307 sub new {
 308     my $class = shift;
 309     my $self = $class->SUPER::new(@_);
 310     return $self;
 311 }
 312
 313
 314 return 1;