view release on metacpan or  search on metacpan

acebrowser/cgi-bin/generic/pic  view on Meta::CPAN

    # Collect some statistics in order to inhibit those features
    # that are too dense to click on sensibly.
    my %centers;
    foreach my $box (@$boxes) {
	my $center = center($box->{'coordinates'});
	$centers{$center}++;
    }

    my $user_agent =  http('User_Agent');
    my $modern = $user_agent=~/Mozilla\/([\d.]+)/ && $1 >= 4;

    my $max = Configuration()->Max_in_column || 100;

    foreach my $box (@$boxes) {
	my $center = center($box->{'coordinates'});
	next if $centers{$center} > $max;
	
	my $coords = join(',',@{$box->{'coordinates'}});
	(my $jcomment = $box->{'comment'} || "$box->{class}:$box->{name}" )
	    =~ s/'/\\'/g; # escape single quotes for javascript

	CASE :
	{

	    if ($box->{name} =~ /gi\|(\d+)/ or 
		($box->{class} eq 'System' and $box->{'comment'}=~/([NP])ID:g(\d+)/)) {
		my($db) = $2 ? $1 : 'n';
		my($gid) = $2 || $1;
		my $url = NCBI . "?db=$db&form=1&field=Sequence+ID&term=$gid";
                push(@lines,qq(<AREA shape="rect"
                                     onMouseOver="return s(this,'$jcomment')"
                                     coords="$coords"
                                     href="$url">));
		last CASE;
	    }

	    last CASE if $box->{class} eq 'System';

	    if ($box->{class} eq 'BUTTON') {
		my ($c) = map { "$_->[0]-$_->[1]" } [ map { 2+$_ } @{$box->{coordinates}}[0..1]];
		my $clicks = $old_clicks ? "$old_clicks,$c" : $c;
                my $url = Url('pic',query_string() . "&click=$clicks");
                push(@lines,qq(<AREA shape="rect"
                                     coords="$coords"
                                     onMouseOver="return s(this,'$jcomment')"
                                     target="_self"
                                     href="$url">));
		last CASE;
	    }
	    my $n = escape($box->{'name'});
	    my $c = escape($box->{'class'});
	    my $href = Object2URL($box->{'name'},$box->{'class'});
            push(@lines,qq(<AREA shape="rect"
                                 onMouseOver="return s(this,'$jcomment')"
                                 coords="$coords"
                                 href="$href">));
	}
    }

    # Create default handling.  Bad use of javascript, but can't think of any other way.
    my $url = Url('pic', query_string());
    my $simple_url = $url;
    $url .= "&click=$old_clicks";
    $url .= "," if $old_clicks;
    push(@lines,qq(<AREA shape="default"
                         alt=""
                         onClick="send_click(event,'$url'); return false"
                         onMouseOver="return s(this,'clickable region')"
                         href="$simple_url">)) if $modern;
    print qq(<map name="theMap">),join("\n",@lines),qq(</map>),"\n";
}

# special case for maps
# this builds the whole map control/navigation panel
sub build_map_navigation_panel {
  my $obj = shift;
  my ($name,$class) = @_;

  my $map_start = param ('map_start');
  my $map_stop  = param ('map_stop');

  my($start,$stop) = $obj->asGif(-getcoords=>1);
  $map_start ||= $start;
  $map_stop  ||= $stop;

  my($min,$max)    = get_extremes($obj->db,$name);

  # this section is responsible for centering on the place the user clicks
  if (param('click')) {
    my ($x,$y) = split '-',param('click');
    my $pos    = $map_start + $y/HEIGHT * ($map_stop - $map_start);

    my $offset = $pos - ($map_start + $map_stop)/2;

    $map_start += $offset;
    $map_stop  += $offset;
    param('map_start' => $map_start);
    param('map_stop'  => $map_stop);

    Delete('click');
  }


  my $self = url(-path_info=>1);
  my $half = ($map_stop - $map_start)/2;
  my $a1   = $map_start - $half;
  $a1      = $min if $min > $a1;
  my $a2   = $map_stop - ($map_start - $a1);

  my $b2   = $map_stop + $half;
  $b2      = $max if $b2 > $max;
  my $b1   = $b2 - ($map_stop - $map_start);

  my $m1   = $map_start + $half/2;
  my $m2   = $map_stop  - $half/2;


  print start_table({-border=>1});
  print TR(td({-align=>'CENTER',-class=>'datatitle',-colspan=>2},'Map Control'));
  print start_TR();
  print td(
	   table({-border=>0},
		 TR(td('&nbsp;'),
		    td(
		       $map_start > $min ?