diff options
Diffstat (limited to 'perllib/Page.pm')
-rw-r--r-- | perllib/Page.pm | 277 |
1 files changed, 4 insertions, 273 deletions
diff --git a/perllib/Page.pm b/perllib/Page.pm index 127fad11b..06bdb27a4 100644 --- a/perllib/Page.pm +++ b/perllib/Page.pm @@ -401,275 +401,6 @@ sub error_page ($$) { print $q->header(-content_length => length($html)), $html; } -# display_map Q PARAMS -# PARAMS include: -# X,Y is bottom left tile of 2x2 grid -# TYPE is 1 if the map is clickable, 2 if clickable and has a form upload, -# 0 if not clickable -# PINS is HTML of pins to show -# PX,PY are coordinates of pin -# PRE/POST are HTML to show above/below map -sub display_map { - my ($q, %params) = @_; - $params{pins} ||= ''; - $params{pre} ||= ''; - $params{post} ||= ''; - my $mid_point = TILE_WIDTH; # Map is 2 TILE_WIDTHs in size, square. - if ($q->{site} eq 'barnet') { # Map is c. 380px wide - $mid_point = 189; - } - my $px = defined($params{px}) ? $mid_point - $params{px} : 0; - my $py = defined($params{py}) ? $mid_point - $params{py} : 0; - my $x = int($params{x})<=0 ? 0 : $params{x}; - my $y = int($params{y})<=0 ? 0 : $params{y}; - my $url = mySociety::Config::get('TILES_URL'); - my $tiles_url = $url . ($x-1) . '-' . $x . ',' . ($y-1) . '-' . $y . '/RABX'; - my $tiles = LWP::Simple::get($tiles_url); - return '<div id="map_box"> <div id="map"><div id="drag">' . _("Unable to fetch the map tiles from the tile server.") . '</div></div></div><div id="side">' if !$tiles; - my $tileids = RABX::unserialise($tiles); - my $tl = ($x-1) . '.' . $y; - my $tr = $x . '.' . $y; - my $bl = ($x-1) . '.' . ($y-1); - my $br = $x . '.' . ($y-1); - return '<div id="side">' if (!$tileids->[0][0] || !$tileids->[0][1] || !$tileids->[1][0] || !$tileids->[1][1]); - my $tl_src = $url . $tileids->[0][0]; - my $tr_src = $url . $tileids->[0][1]; - my $bl_src = $url . $tileids->[1][0]; - my $br_src = $url . $tileids->[1][1]; - - my $out = ''; - my $cobrand = Page::get_cobrand($q); - my $root_path_js = Cobrand::root_path_js($cobrand, $q); - my $cobrand_form_elements = Cobrand::form_elements($cobrand, 'mapForm', $q); - my $img_type; - my $form_action = Cobrand::url($cobrand, '', $q); - if ($params{type}) { - my $encoding = ''; - $encoding = ' enctype="multipart/form-data"' if ($params{type}==2); - my $pc = $q->param('pc') || ''; - my $pc_enc = ent($pc); - $out .= <<EOF; -<form action="$form_action" method="post" name="mapForm" id="mapForm"$encoding> -<input type="hidden" name="submit_map" value="1"> -<input type="hidden" name="x" id="formX" value="$x"> -<input type="hidden" name="y" id="formY" value="$y"> -<input type="hidden" name="pc" value="$pc_enc"> -$cobrand_form_elements -EOF - $img_type = '<input type="image"'; - } else { - $img_type = '<img'; - } - my $imgw = TILE_WIDTH . 'px'; - my $tile_width = TILE_WIDTH; - my $tile_type = mySociety::Config::get('TILES_TYPE'); - $out .= <<EOF; -<script type="text/javascript"> -$root_path_js -var fixmystreet = { - 'x': $x - 3, - 'y': $y - 3, - 'start_x': $px, - 'start_y': $py, - 'tile_type': '$tile_type', - 'tilewidth': $tile_width, - 'tileheight': $tile_width -}; -</script> -<div id="map_box"> -$params{pre} - <div id="map"><div id="drag"> - $img_type alt="NW map tile" id="t2.2" name="tile_$tl" src="$tl_src" style="top:0px; left:0;">$img_type alt="NE map tile" id="t2.3" name="tile_$tr" src="$tr_src" style="top:0px; left:$imgw;"><br>$img_type alt="SW map tile" id="t3.2" name="tile_$bl" src="$bl_src" style="top:$imgw; left:0;">$img_type alt="SE map tile" id="t3.3" name="tile_$br" src="$br_src" style="top:$imgw; left:$imgw;"> - <div id="pins">$params{pins}</div> - </div> -EOF - if (Cobrand::show_watermark($cobrand) && mySociety::Config::get('TILES_TYPE') ne 'streetview') { - $out .= '<div id="watermark"></div>'; - } - $out .= compass($q, $x, $y); - my $copyright; - if (mySociety::Config::get('TILES_TYPE') eq 'streetview') { - $copyright = _('Map contains Ordnance Survey data © Crown copyright and database right 2010.'); - } else { - $copyright = _('© Crown copyright. All rights reserved. Ministry of Justice 100037819 2008.'); - } - $out .= <<EOF; - </div> - <p id="copyright">$copyright</p> -$params{post} -EOF - $out .= '</div>'; - $out .= '<div id="side">'; - return $out; -} - -sub display_map_end { - my ($type) = @_; - my $out = '</div>'; - $out .= '</form>' if ($type); - return $out; -} - -sub display_pin { - my ($q, $px, $py, $col, $num) = @_; - $num = '' if !$num || $num > 9; - my $host = base_url_with_lang($q, undef); - my %cols = (red=>'R', green=>'G', blue=>'B', purple=>'P'); - my $out = '<img class="pin" src="' . $host . '/i/pin' . $cols{$col} - . $num . '.gif" alt="' . _('Problem') . '" style="top:' . ($py-59) - . 'px; left:' . ($px) . 'px; position: absolute;">'; - return $out unless $_ && $_->{id} && $col ne 'blue'; - my $cobrand = Page::get_cobrand($q); - my $url = Cobrand::url($cobrand, NewURL($q, -retain => 1, - -url => '/report/' . $_->{id}, - pc => undef, - x => undef, - y => undef, - sx => undef, - sy => undef, - all_pins => undef, - no_pins => undef), $q); - $out = '<a title="' . ent($_->{title}) . '" href="' . $url . '">' . $out . '</a>'; - return $out; -} - -sub map_pins { - my ($q, $x, $y, $sx, $sy, $interval) = @_; - - my $pins = ''; - my $min_e = Page::tile_to_os($x-3); # Extra space to left/below due to rounding, I think - my $min_n = Page::tile_to_os($y-3); - my $mid_e = Page::tile_to_os($x); - my $mid_n = Page::tile_to_os($y); - my $max_e = Page::tile_to_os($x+2); - my $max_n = Page::tile_to_os($y+2); - my $cobrand = Page::get_cobrand($q); - # list of problems aoround map can be limited, but should show all pins - my $around_limit = Cobrand::on_map_list_limit($cobrand); - my $around_map; - my $around_map_list = Problems::around_map($min_e, $max_e, $min_n, $max_n, $interval, $around_limit); - if ($around_limit) { - $around_map = Problems::around_map($min_e, $max_e, $min_n, $max_n, $interval, undef); - } else { - $around_map = $around_map_list; - } - my @ids = (); - foreach (@$around_map_list) { - push(@ids, $_->{id}); - } - foreach (@$around_map) { - my $px = Page::os_to_px($_->{easting}, $sx); - my $py = Page::os_to_px($_->{northing}, $sy, 1); - my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; - $pins .= Page::display_pin($q, $px, $py, $col); - } - - my $dist; - mySociety::Locale::in_gb_locale { - my ($lat, $lon) = mySociety::GeoUtil::national_grid_to_wgs84($mid_e, $mid_n, 'G'); - $dist = mySociety::Gaze::get_radius_containing_population($lat, $lon, 200000); - }; - $dist = int($dist*10+0.5)/10; - - my $limit = 20; # - @$current_map; - my $nearby = Problems::nearby($dist, join(',', @ids), $limit, $mid_e, $mid_n, $interval); - foreach (@$nearby) { - my $px = Page::os_to_px($_->{easting}, $sx); - my $py = Page::os_to_px($_->{northing}, $sy, 1); - my $col = $_->{state} eq 'fixed' ? 'green' : 'red'; - $pins .= Page::display_pin($q, $px, $py, $col); - } - - return ($pins, $around_map_list, $nearby, $dist); -} - -sub compass ($$$) { - my ($q, $x, $y) = @_; - my @compass; - for (my $i=$x-1; $i<=$x+1; $i++) { - for (my $j=$y-1; $j<=$y+1; $j++) { - $compass[$i][$j] = NewURL($q, x=>$i, y=>$j); - } - } - my $recentre = NewURL($q); - my $host = base_url_with_lang($q, undef); - return <<EOF; -<table cellpadding="0" cellspacing="0" border="0" id="compass"> -<tr valign="bottom"> -<td align="right"><a rel="nofollow" href="${compass[$x-1][$y+1]}"><img src="$host/i/arrow-northwest.gif" alt="NW" width=11 height=11></a></td> -<td align="center"><a rel="nofollow" href="${compass[$x][$y+1]}"><img src="$host/i/arrow-north.gif" vspace="3" alt="N" width=13 height=11></a></td> -<td><a rel="nofollow" href="${compass[$x+1][$y+1]}"><img src="$host/i/arrow-northeast.gif" alt="NE" width=11 height=11></a></td> -</tr> -<tr> -<td><a rel="nofollow" href="${compass[$x-1][$y]}"><img src="$host/i/arrow-west.gif" hspace="3" alt="W" width=11 height=13></a></td> -<td align="center"><a rel="nofollow" href="$recentre"><img src="$host/i/rose.gif" alt="Recentre" width=35 height=34></a></td> -<td><a rel="nofollow" href="${compass[$x+1][$y]}"><img src="$host/i/arrow-east.gif" hspace="3" alt="E" width=11 height=13></a></td> -</tr> -<tr valign="top"> -<td align="right"><a rel="nofollow" href="${compass[$x-1][$y-1]}"><img src="$host/i/arrow-southwest.gif" alt="SW" width=11 height=11></a></td> -<td align="center"><a rel="nofollow" href="${compass[$x][$y-1]}"><img src="$host/i/arrow-south.gif" vspace="3" alt="S" width=13 height=11></a></td> -<td><a rel="nofollow" href="${compass[$x+1][$y-1]}"><img src="$host/i/arrow-southeast.gif" alt="SE" width=11 height=11></a></td> -</tr> -</table> -EOF -} - -# P is easting or northing -# C is centre tile reference of displayed map -sub os_to_px { - my ($p, $c, $invert) = @_; - return tile_to_px(os_to_tile($p), $c, $invert); -} - -# Convert tile co-ordinates to pixel co-ordinates from top left of map -# C is centre tile reference of displayed map -sub tile_to_px { - my ($p, $c, $invert) = @_; - $p = TILE_WIDTH * ($p - $c + 1); - $p = 2 * TILE_WIDTH - $p if $invert; - $p = int($p + .5 * ($p <=> 0)); - return $p; -} - -# Tile co-ordinates are linear scale of OS E/N -# Will need more generalising when more zooms appear -sub os_to_tile { - return $_[0] / SCALE_FACTOR; -} -sub tile_to_os { - return int($_[0] * SCALE_FACTOR + 0.5); -} - -sub click_to_tile { - my ($pin_tile, $pin, $invert) = @_; - $pin -= TILE_WIDTH while $pin > TILE_WIDTH; - $pin += TILE_WIDTH while $pin < 0; - $pin = TILE_WIDTH - $pin if $invert; # image submits measured from top down - return $pin_tile + $pin / TILE_WIDTH; -} - -sub os_to_px_with_adjust { - my ($q, $easting, $northing, $in_x, $in_y) = @_; - - my $x = Page::os_to_tile($easting); - my $y = Page::os_to_tile($northing); - my $x_tile = $in_x || int($x); - my $y_tile = $in_y || int($y); - my $px = Page::os_to_px($easting, $x_tile); - my $py = Page::os_to_px($northing, $y_tile, 1); - if ($q->{site} eq 'barnet') { # Map is 380px - if ($py > 380) { - $y_tile--; - $py = Page::os_to_px($northing, $y_tile, 1); - } - if ($px > 380) { - $x_tile++; - $px = Page::os_to_px($easting, $x_tile); - } - } - return ($x, $y, $x_tile, $y_tile, $px, $py); -} - # send_email TO (NAME) TEMPLATE-NAME PARAMETERS # TEMPLATE-NAME is currently one of problem, update, alert, tms sub send_email { @@ -943,8 +674,8 @@ sub geocode { unless ($error = mapit_check_error($location)) { $easting = $location->{easting}; $northing = $location->{northing}; - my $xx = Page::os_to_tile($easting); - my $yy = Page::os_to_tile($northing); + my $xx = FixMyStreet::Map::os_to_tile($easting); + my $yy = FixMyStreet::Map::os_to_tile($northing); $x = int($xx); $y = int($yy); $x += 1 if ($xx - $x > 0.5); @@ -968,8 +699,8 @@ sub geocoded_string_coordinates { my $lon = $1; my $lat = $2; try { ($easting, $northing) = mySociety::GeoUtil::wgs84_to_national_grid($lat, $lon, 'G'); - my $xx = Page::os_to_tile($easting); - my $yy = Page::os_to_tile($northing); + my $xx = FixMyStreet::Map::os_to_tile($easting); + my $yy = FixMyStreet::Map::os_to_tile($northing); $x = int($xx); $y = int($yy); $x += 1 if ($xx - $x > 0.5); |