view release on metacpan or  search on metacpan

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

    # 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 ?
		       a({-href=>"$self?name=$name;class=$class;map_start=$a1;map_stop=$a2"},
			 img({-src=>UP_ICON,-align=>'MIDDLE',-border=>0}),' Up')
		       :
		       font({-color=>'#A0A0A0'},img({-src=>UP_ICON,-align=>'MIDDLE',-border=>0}),' Up')
		      ),
		    td('&nbsp;')
		   ),
		 TR(td({-valign=>'CENTER',-align=>'CENTER'},
		       a({-href=>"$self?name=$name;class=$class;map_start=$a1;map_stop=$b2"},
			 img({-src=>ZOOMOUT_ICON,-align=>'MIDDLE',-border=>0}),' Shrink')
		      ),
		    td({-valign=>'CENTER',-align=>'CENTER'},
		       a({-href=>"$self?name=$name;class=$class;map_start=$min;map_stop=$max"},'WHOLE')
		      ),
		    td({-valign=>'CENTER',-align=>'CENTER'},
		       a({-href=>"$self?name=$name;class=$class;map_start=$m1;map_stop=$m2"},
			 img({-src=>ZOOMIN_ICON,-align=>'MIDDLE',-border=>0}),' Magnify')
		      )
		   ),
		 TR(td('&nbsp;'),
		    td(
		       $map_stop < $max ?
		       a({-href=>"$self?name=$name;class=$class;map_start=$b1;map_stop=$b2"},
			 img({-src=>DOWN_ICON,-align=>'MIDDLE',-border=>0}),' Down')
		       :
		       font({-color=>'#A0A0A0'},img({-src=>DOWN_ICON,-align=>'MIDDLE',-border=>0}),' Down')
		      ),
		    td('&nbsp;'))
		)

	  );
  print start_td({-rowspan=>2});

  print start_form;
  print start_p;
  print hidden($_) foreach qw(class name);
  print 'Show region between: ',
    textfield(-name=>'map_start',-value=>sprintf("%.2f",$map_start),-size=>8,-override=>1),
      ' and ',
	textfield(-name=>'map_stop',- value=>sprintf("%.2f",$map_stop),-size=>8,-override=>1),
	  ' ';
  print submit('Change');
  print end_p;
  print end_form;
  print end_td(),end_TR(),end_table();
}

sub get_extremes {
  my $db = shift;
  my $chrom = shift;
  my $select = qq(select gm[Position] from g in object("Map","$chrom")->Contains[2], gm in g->Map where gm = "$chrom");
  my @positions = $db->aql("select min($select),max($select)");
  my ($min,$max) = @{$positions[0]}[0,1];
  return ($min,$max);