AcePerl
view release on metacpan or search on metacpan
acebrowser/cgi-bin/generic/pic view on Meta::CPAN
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(' '),
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(' ')
),
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(' '),
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(' '))
)
);
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);
}
sub center {
my $c = shift;
my ($left,$right) = @{$c}[0,2];
# round to nearest 2 pixels
int( ($left + (($right-$left)/2)) / 2 ) * 2;
}
( run in 0.897 second using v1.01-cache-2.11-cpan-ceb78f64989 )