view release on metacpan or  search on metacpan

cgi-bin/gbrowse_syn  view on Meta::CPAN

sub overview_panel {
  my ($whole_segment,$segment) = @_;
  return '' if $SCONF->section_setting('overview') eq 'hide';
  my $image = overview($whole_segment,$segment);
  my $ref = $MAP->{$CONF->page_settings("search_src")}->{desc};

  my $width = $CONF->page_settings('imagewidth') || $CONF->setting("imagewidth") || IMAGE_WIDTH;
  my $ip = $SCONF->setting('image_padding') || $CONF->image_padding || param('image_padding') || 0;
  my $pl = $SCONF->setting('pad_left')  || 0;
  my $pr = $SCONF->setting('pad_right') || 0;
  $width += ($pl || $ip) + ($pr || $ip);

  return toggle('Overview',
                table({-border=>0,-width=>'100%'},
		      TR(th("<center>Reference genome: <i>$ref</i></center>")),
                      TR({-class=>'databody'},
			 td({-align=>'center'},
			    div({ id => 'overview_panels',
				  style => "position:relative;width:${width}px"},
				$image)
		            )
                    )
		)
      );
}

sub overview {
  my ($region_segment,$segment) = @_;
  return unless $segment;
  my $width = $CONF->page_settings('imagewidth')   || IMAGE_WIDTH;
  $width *= $CONF->setting('overview_ratio') || OVERVIEW_RATIO;
  $CONF->width($width);
  
  # the postgrid will be invoked to hilite the currently selected region
  my $postgrid = hilite_regions_closure([$segment->start,$segment->end,'yellow']);

  # reference genome
  my $ref = $MAP->{$CONF->page_settings("search_src")}->{desc};

  my ($overview)   = $CONF->render_panels(
						  {
						    length         => $segment->length,
						    section        => 'overview',
						    segment        => $region_segment,
						    postgrid       => $postgrid,
						    label_scale    => 2,
						    lang           => $SCONF->language,
						    keystyle       => 'left',
						    settings       => $CONF->page_settings(),
						    scale_map_type => 'centering_map',
						    cache_extra    => [$segment->start,$segment->end],
						    do_map         => 1,
						    drag_n_drop    => 0,
						    image_button   => 0,
						    -grid          => 0,
						    -pad_top       => 5,
						    -bgcolor       => $CONF->setting('overview bgcolor') || OVERVIEW_BGCOLOR,
						  }
						  );

  # make sure overview is busy with redirects
  #my $server =$ENV{SERVER_NAME};
  #if ($server) {
  #  $overview =~ s/src="/src="http:\/\/$server\//;
  #}

  return div({-id=>'overview',-class=>'track'},$overview);
}

sub toggle {
  my $title         = shift;
  my @body           = @_;

  my $id      = "\L${title}_panel\E";
  my ($label) = $CONF->tr($title)              or return '';
  my $state   = $CONF->section_setting($title) || 'open';
  return '' if $state eq 'off';
  my $settings = $CONF->page_settings;
  my $visible = exists $settings->{section_visible}{$id} ? $settings->{section_visible}{$id} : $state eq 'open';
  $settings->{section_visible}{$id} = $state eq 'open';

  return toggle_section({on=>$visible},
			$id,
			b($label),
			@body);
}

sub get_options {
  my $tracks_to_show = shift;
  my $settings = $CONF->page_settings;
  my %options    = map {$_=>$settings->{features}{$_}{options}} @$tracks_to_show;
  my %limits     = map {$_=>$settings->{features}{$_}{limit}}   @$tracks_to_show;
  return (\%options,\%limits);
}

sub hilite_regions_closure {
  my @h_regions = @_;

  return sub {
    my $gd     = shift;
    my $panel  = shift;
    my $left   = $panel->pad_left;
    my $top    = $panel->top;
    my $bottom = $panel->bottom;
    for my $r (@h_regions) {
      my ($h_start,$h_end,$h_color) = @$r;
      my ($start,$end) = $panel->location2pixel($h_start,$h_end);
      if ($end-$start <= 1) { $end++; $start-- } # so that we always see something

      # assuming top is 0 so as to ignore top padding
      $gd->filledRectangle($left+$start,0,$left+$end,$bottom,
			   $panel->translate_color($h_color));
    }
  };
}

sub feature2segment {
  my $feature = shift;
  return $feature if ref $feature eq 'Bio::DB::GFF::RelSegment';
  my $refclass = $CONF->setting('reference class') || 'Sequence';
  my $db = open_database();