base files for displaying WMS maps

Basic config and setup files for using WMS based map tiles. These still
require config in appropriate cobrand perl and javascript files

3 files changed, 362 insertions, 171 deletions

diff --git a/perllib/FixMyStreet/Map/WMSBase.pm b/perllib/FixMyStreet/Map/WMSBase.pm
new file mode 100644
index 000000000..ce8b6ab38
--- /dev/null
+++ b/perllib/FixMyStreet/Map/WMSBase.pm
@@ -0,0 +1,151 @@
+# FixMyStreet:Map::WMSBase
+# Makes it easier for cobrands to use their own WMS base map.
+# This cannot be used directly; you must subclass it and implement several
+# methods. See, e.g. FixMyStreet::Map::Northamptonshire.
+
+package FixMyStreet::Map::WMSBase;
+use parent FixMyStreet::Map::WMXBase;
+
+use strict;
+
+# A hash of parameters used in calculations for map tiles
+sub tile_parameters {
+    my $params = {
+        urls         => [ '' ], # URL of the map tiles, up to the /{z}/{x}/{y} part
+        layer_names  => [ '' ],
+        wms_version => '1.0.0',
+        size         => 256, # pixels
+        dpi          => 96,
+        inches_per_unit => 0, # See OpenLayers.INCHES_PER_UNIT for some options.
+        projection   => 'EPSG:3857', # Passed through to OpenLayers.Projection
+    };
+    return $params;
+}
+
+# This is used to determine which template to render the map with
+sub map_template { 'wms' }
+
+sub get_res {
+    my ($self, $zoom) = @_;
+
+    my @scales = $self->scales;
+
+    my $res = $scales[$zoom] /
+        ($self->tile_parameters->{inches_per_unit} * $self->tile_parameters->{dpi});
+
+    return $res;
+}
+
+sub _get_tile_size {
+    my ($self, $params) = @_;
+
+    my $res = $self->get_res($params->{zoom});
+    return $res * $self->tile_parameters->{size};
+}
+
+sub _get_tile_params {
+    my ($self, $params, $left_col, $top_row, $z, $tile_url, $size) = @_;
+
+    my ($min_x, $min_y, $max_x, $max_y) = ($left_col, $top_row - $size, $left_col + $size, $top_row);
+
+    return ($tile_url, $min_x, $min_y, $max_x, $max_y);
+}
+
+sub _get_tile_src {
+    my ($self, $tile_url, $min_x, $min_y, $max_x, $max_y, $col, $row) = @_;
+
+    my $src = sprintf( '%s&bbox=%d,%d,%d,%d',
+        $tile_url, $min_x + $col, $min_y - $row, $max_x + $col, $max_y - $row);
+
+    return $src;
+}
+
+sub _get_tile_id {
+    my ($self, $tile_url, $min_x, $min_y, $max_x, $max_y, $col, $row) = @_;
+
+    return sprintf( '%d.%d', ($min_x + $col), ($min_y - $row) );
+}
+
+sub _get_row {
+    my ($self, $top_row, $row_offset, $size) = @_;
+    return $row_offset * $size;
+}
+
+sub _get_col {
+    my ($self, $left_col, $col_offset, $size) = @_;
+    return $col_offset * $size;
+}
+
+sub map_type { 'OpenLayers.Layer.WMS' }
+
+sub _map_hash_extras {
+    my $self = shift;
+
+    return {
+        wms_version => $self->tile_parameters->{wms_version},
+        format => $self->tile_parameters->{format},
+    };
+}
+
+sub tile_base_url {
+    my $self = shift;
+    my $params = $self->tile_parameters;
+    return sprintf '%s?version=%s&format=%s&size=%s&width=%s&height=%s&service=WMS&layers=%s&request=GetMap&srs=%s',
+        $params->{urls}[0], $params->{wms_version}, $params->{format}, $params->{size}, $params->{size},
+        $params->{size}, $params->{layer_names}[0], $params->{projection};
+}
+
+# Given a lat/lon, convert it to tile co-ordinates (nearest actual tile,
+# adjusted so the point will be near the centre of a 2x2 tiled map).
+sub latlon_to_tile_with_adjust {
+    my ($self, $lat, $lon, $zoom, $rows, $cols) = @_;
+    my ($x_tile, $y_tile)
+        = $self->reproject_from_latlon($lat, $lon, $zoom);
+
+    my $tile_params = $self->tile_parameters;
+    my $res = $self->get_res($zoom);
+
+    $x_tile = $x_tile -  ($res * $tile_params->{size});
+    $y_tile = $y_tile + ($res * $tile_params->{size});
+
+    return ( int($x_tile), int($y_tile) );
+}
+
+sub tile_to_latlon {
+    my ($self, $fx, $fy, $zoom) = @_;
+    my ($lat, $lon) = $self->reproject_to_latlon($fx, $fy);
+
+    return ($lat, $lon);
+}
+
+# Given a lat/lon, convert it to pixel co-ordinates from the top left of the map
+sub latlon_to_px($$$$$$) {
+    my ($self, $lat, $lon, $x_tile, $y_tile, $zoom) = @_;
+    my ($pin_x_tile, $pin_y_tile) = $self->reproject_from_latlon($lat, $lon, $zoom);
+    my $res = $self->get_res($zoom);
+    my $pin_x = ( $pin_x_tile - $x_tile ) / $res;
+    my $pin_y = ( $y_tile - $pin_y_tile ) / $res;
+    return ($pin_x, $pin_y);
+}
+
+sub click_to_tile {
+    my ($self, $pin_tile, $pin, $zoom, $reverse) = @_;
+    my $tile_params = $self->tile_parameters;
+    my $size = $tile_params->{size};
+    my $res = $self->get_res($zoom);
+
+    return $reverse ? $pin_tile + ( ( $size - $pin ) * $res ) : $pin_tile + ( $pin * $res );
+}
+
+# Given some click co-ords (the tile they were on, and where in the
+# tile they were), convert to WGS84 and return.
+sub click_to_wgs84 {
+    my ($self, $c, $pin_tile_x, $pin_x, $pin_tile_y, $pin_y) = @_;
+    my $zoom = (defined $c->get_param('zoom') ? $c->get_param('zoom') : $self->zoom_parameters->{default_zoom});
+    my $tile_x = $self->click_to_tile($pin_tile_x, $pin_x, $zoom);
+    my $tile_y = $self->click_to_tile($pin_tile_y, $pin_y, $zoom, 1);
+    my ($lat, $lon) = $self->tile_to_latlon($tile_x, $tile_y, $zoom);
+    return ( $lat, $lon );
+}
+
+1;
diff --git a/perllib/FixMyStreet/Map/WMTSBase.pm b/perllib/FixMyStreet/Map/WMTSBase.pm
index 051f8f369..e482b3f37 100644
--- a/perllib/FixMyStreet/Map/WMTSBase.pm
+++ b/perllib/FixMyStreet/Map/WMTSBase.pm
@@ -4,40 +4,9 @@
 # methods. See, e.g. FixMyStreet::Map::Zurich or FixMyStreet::Map::Bristol.
 
 package FixMyStreet::Map::WMTSBase;
+use parent FixMyStreet::Map::WMXBase;
 
 use strict;
-use Math::Trig;
-use Utils;
-use JSON::MaybeXS;
-
-sub scales {
-    my $self = shift;
-    my @scales = (
-        # A list of scales corresponding to zoom levels, e.g.
-        # '192000',
-        # '96000',
-        # '48000',
-        # etc...
-    );
-    return @scales;
-}
-
-# The copyright string to display in the corner of the map.
-sub copyright {
-    return '';
-}
-
-# A hash of parameters that control the zoom options for the map
-sub zoom_parameters {
-    my $self = shift;
-    my $params = {
-        zoom_levels    => scalar $self->scales,
-        default_zoom   => 0,
-        min_zoom_level => 0,
-        id_offset      => 0,
-    };
-    return $params;
-}
 
 # A hash of parameters used in calculations for map tiles
 sub tile_parameters {
@@ -58,162 +27,46 @@ sub tile_parameters {
     return $params;
 }
 
-# This is used to determine which template to render the map with
-sub map_template { 'fms' }
+sub _get_tile_params {
+    my ($self, $params, $left_col, $top_row, $z, $tile_url) = @_;
 
-# Reproject a WGS84 lat/lon into an x/y coordinate in this map's CRS.
-# Subclasses will want to override this.
-sub reproject_from_latlon($$$) {
-    my ($self, $lat, $lon) = @_;
-    return (0.0, 0.0);
+    return ($tile_url, $z, $self->tile_parameters->{suffix});
 }
 
-# Reproject a x/y coordinate from this map's CRS into WGS84 lat/lon
-# Subclasses will want to override this.
-sub reproject_to_latlon($$$) {
-    my ($self, $x, $y) = @_;
-    return (0.0, 0.0);
+sub _get_tile_src {
+    my ($self, $tile_url, $z, $suffix, $col, $row) = @_;
+
+    return sprintf( '%s/%d/%d/%d%s',
+        $tile_url, $z, $row, $col, $suffix);
 }
 
+sub _get_tile_id {
+    my ($self, $tile_url, $x, $suffix, $col, $row) = @_;
 
-sub map_tiles {
-    my ($self, %params) = @_;
-    my ($left_col, $top_row, $z) = @params{'x_left_tile', 'y_top_tile', 'matrix_id'};
-    my $tile_url = $self->tile_base_url;
-    my $tile_suffix = $self->tile_parameters->{suffix};
-    my $cols = $params{cols};
-    my $rows = $params{rows};
-
-    my @col_offsets = (0.. ($cols-1) );
-    my @row_offsets = (0.. ($rows-1) );
-
-    return [
-        map {
-            my $row_offset = $_;
-            [
-                map {
-                    my $col_offset = $_;
-                    my $row = $top_row + $row_offset;
-                    my $col = $left_col + $col_offset;
-                    my $src = sprintf '%s/%d/%d/%d%s',
-                        $tile_url, $z, $row, $col, $tile_suffix;
-                    my $dotted_id = sprintf '%d.%d', $col, $row;
-
-                    # return the data structure for the cell
-                    +{
-                        src => $src,
-                        row_offset => $row_offset,
-                        col_offset => $col_offset,
-                        dotted_id => $dotted_id,
-                        alt => "Map tile $dotted_id", # TODO "NW map tile"?
-                    }
-                }
-                @col_offsets
-            ]
-        }
-        @row_offsets
-    ];
+    return sprintf( '%d.%d', $col, $row);
 }
 
-# display_map C PARAMS
-# PARAMS include:
-# latitude, longitude for the centre point of the map
-# CLICKABLE is set if the map is clickable
-# PINS is array of pins to show, location and colour
-sub display_map {
-    my ($self, $c, %params) = @_;
-
-    # Map centre may be overridden in the query string
-    $params{latitude} = Utils::truncate_coordinate($c->get_param('lat') + 0)
-        if defined $c->get_param('lat');
-    $params{longitude} = Utils::truncate_coordinate($c->get_param('lon') + 0)
-        if defined $c->get_param('lon');
-
-    $params{rows} //= 2; # 2x2 square is default
-    $params{cols} //= 2;
-
-    my $zoom_params = $self->zoom_parameters;
-
-    $params{zoom} = do {
-        my $zoom = defined $c->get_param('zoom')
-            ? $c->get_param('zoom') + 0
-            : $c->stash->{page} eq 'report'
-                ? $zoom_params->{default_zoom}+1
-                : $zoom_params->{default_zoom};
-        $zoom = $zoom_params->{zoom_levels} - 1
-            if $zoom >= $zoom_params->{zoom_levels};
-        $zoom = 0 if $zoom < 0;
-        $zoom;
-    };
+sub _get_row {
+    my ($self, $top_row, $row_offset, $size) = @_;
+    return $top_row + $row_offset;
+}
 
-    $c->stash->{map} = $self->get_map_hash( %params );
-
-    if ($params{print_report}) {
-        $params{zoom}++ unless $params{zoom} >= $zoom_params->{zoom_levels};
-        $c->stash->{print_report_map}
-            = $self->get_map_hash(
-                %params,
-                img_type => 'img',
-                cols => 4, rows => 4,
-            );
-        # NB: we can passthrough img_type as literal here, as only designed for print
-
-        # NB we can do arbitrary size, including non-squares, however we'd have
-        # to modify .square-map style with padding-bottom percentage calculated in
-        # an inline style:
-        # <zarino> in which case, the only change that'd be required is
-        # removing { padding-bottom: 100% } from .square-map__outer, putting
-        # the percentage into an inline style on the element itself, and then
-        # probably renaming .square-map__* to .fixed-aspect-map__* or something
-        # since it's no longer necessarily square
-    }
+sub _get_col {
+    my ($self, $left_col, $col_offset, $size) = @_;
+    return $left_col + $col_offset;
 }
 
-sub get_map_hash {
-    my ($self, %params) = @_;
-
-    @params{'x_centre_tile', 'y_centre_tile', 'matrix_id'}
-        = $self->latlon_to_tile_with_adjust(
-            @params{'latitude', 'longitude', 'zoom', 'rows', 'cols'});
-
-    # centre_(row|col) is either in middle, or just to right.
-    # e.g. if centre is the number in parens:
-    # 1 (2) 3 => 2 - int( 3/2 ) = 1
-    # 1 2 (3) 4 => 3 - int( 4/2 ) = 1
-    $params{x_left_tile} = $params{x_centre_tile} - int($params{cols} / 2);
-    $params{y_top_tile}  = $params{y_centre_tile} - int($params{rows} / 2);
-
-    $params{pins} = [
-        map {
-            my $pin = { %$_ }; # shallow clone
-            ($pin->{px}, $pin->{py})
-                = $self->latlon_to_px($pin->{latitude}, $pin->{longitude},
-                            @params{'x_left_tile', 'y_top_tile', 'zoom'});
-            $pin;
-        } @{ $params{pins} }
-    ];
+sub map_type { 'OpenLayers.Layer.WMTS' }
+
+sub _map_hash_extras {
+    my $self = shift;
 
-    my @scales = $self->scales;
     return {
-        %params,
-        type => $self->map_template,
-        map_type => 'OpenLayers.Layer.WMTS',
-        tiles => $self->map_tiles( %params ),
-        copyright => $self->copyright(),
-        zoom => $params{zoom},
-        zoomOffset => $self->zoom_parameters->{min_zoom_level},
-        numZoomLevels => $self->zoom_parameters->{zoom_levels},
-        tile_size => $self->tile_parameters->{size},
-        tile_dpi => $self->tile_parameters->{dpi},
-        tile_urls => encode_json( $self->tile_parameters->{urls} ),
-        tile_suffix => $self->tile_parameters->{suffix},
-        layer_names => encode_json( $self->tile_parameters->{layer_names} ),
         layer_style => $self->tile_parameters->{layer_style},
         matrix_set => $self->tile_parameters->{matrix_set},
-        map_projection => $self->tile_parameters->{projection},
         origin_x => force_float_format($self->tile_parameters->{origin_x}),
         origin_y => force_float_format($self->tile_parameters->{origin_y}),
-        scales => encode_json( \@scales ),
+        tile_suffix => $self->tile_parameters->{suffix},
     };
 }
 
diff --git a/perllib/FixMyStreet/Map/WMXBase.pm b/perllib/FixMyStreet/Map/WMXBase.pm
new file mode 100644
index 000000000..c2ed77692
--- /dev/null
+++ b/perllib/FixMyStreet/Map/WMXBase.pm
@@ -0,0 +1,187 @@
+# FixMyStreet:Map::WMXBase
+# Common methods for WMS and WMTS maps
+
+package FixMyStreet::Map::WMXBase;
+
+use strict;
+use Math::Trig;
+use Utils;
+use JSON::MaybeXS;
+
+sub scales {
+    my $self = shift;
+    my @scales = (
+        # A list of scales corresponding to zoom levels, e.g.
+        # '192000',
+        # '96000',
+        # '48000',
+        # etc...
+    );
+    return @scales;
+}
+
+# The copyright string to display in the corner of the map.
+sub copyright {
+    return '';
+}
+
+# A hash of parameters that control the zoom options for the map
+sub zoom_parameters {
+    my $self = shift;
+    my $params = {
+        zoom_levels    => scalar $self->scales,
+        default_zoom   => 0,
+        min_zoom_level => 0,
+        id_offset      => 0,
+    };
+    return $params;
+}
+
+# This is used to determine which template to render the map with
+sub map_template { 'fms' }
+
+# Reproject a WGS84 lat/lon into an x/y coordinate in this map's CRS.
+# Subclasses will want to override this.
+sub reproject_from_latlon($$$) {
+    my ($self, $lat, $lon) = @_;
+    return (0.0, 0.0);
+}
+
+# Reproject a x/y coordinate from this map's CRS into WGS84 lat/lon
+# Subclasses will want to override this.
+sub reproject_to_latlon($$$) {
+    my ($self, $x, $y) = @_;
+    return (0.0, 0.0);
+}
+
+sub _get_tile_size {
+    return shift->tile_parameters->{size};
+}
+
+sub map_tiles {
+    my ($self, %params) = @_;
+    my ($left_col, $top_row, $z) = @params{'x_left_tile', 'y_top_tile', 'matrix_id'};
+    my $tile_url = $self->tile_base_url;
+    my $cols = $params{cols};
+    my $rows = $params{rows};
+
+    my @col_offsets = (0.. ($cols-1) );
+    my @row_offsets = (0.. ($rows-1) );
+
+    my $size = $self->_get_tile_size(\%params);
+    my @params = $self->_get_tile_params(\%params, $left_col, $top_row, $z, $tile_url, $size);
+
+    return [
+        map {
+            my $row_offset = $_;
+            [
+                map {
+                    my $col_offset = $_;
+                    my $row = $self->_get_row($top_row, $row_offset, $size);
+                    my $col = $self->_get_col($left_col, $col_offset, $size);
+                    my $src = $self->_get_tile_src(@params, $col, $row);
+                    my $dotted_id = $self->_get_tile_id(@params, $col, $row);
+
+                    # return the data structure for the cell
+                    +{
+                        src => $src,
+                        row_offset => $row_offset,
+                        col_offset => $col_offset,
+                        dotted_id => $dotted_id,
+                        alt => "Map tile $dotted_id",
+                    }
+                }
+                @col_offsets
+            ]
+        }
+        @row_offsets
+    ];
+}
+
+# display_map C PARAMS
+# PARAMS include:
+# latitude, longitude for the centre point of the map
+# CLICKABLE is set if the map is clickable
+# PINS is array of pins to show, location and colour
+sub display_map {
+    my ($self, $c, %params) = @_;
+
+    # Map centre may be overridden in the query string
+    $params{latitude} = Utils::truncate_coordinate($c->get_param('lat') + 0)
+        if defined $c->get_param('lat');
+    $params{longitude} = Utils::truncate_coordinate($c->get_param('lon') + 0)
+        if defined $c->get_param('lon');
+
+    $params{rows} //= 2; # 2x2 square is default
+    $params{cols} //= 2;
+
+    my $zoom_params = $self->zoom_parameters;
+
+    $params{zoom} = do {
+        my $zoom = defined $c->get_param('zoom')
+            ? $c->get_param('zoom') + 0
+            : $c->stash->{page} eq 'report'
+                ? $zoom_params->{default_zoom}+1
+                : $zoom_params->{default_zoom};
+        $zoom = $zoom_params->{zoom_levels} - 1
+            if $zoom >= $zoom_params->{zoom_levels};
+        $zoom = 0 if $zoom < 0;
+        $zoom;
+    };
+
+    $c->stash->{map} = $self->get_map_hash( %params );
+
+    if ($params{print_report}) {
+        $params{zoom}++ unless $params{zoom} >= $zoom_params->{zoom_levels};
+        $c->stash->{print_report_map}
+            = $self->get_map_hash(
+                %params,
+                img_type => 'img',
+                cols => 4, rows => 4,
+            );
+    }
+}
+
+sub _map_hash_extras { return {} }
+
+sub get_map_hash {
+    my ($self, %params) = @_;
+
+    @params{'x_centre_tile', 'y_centre_tile', 'matrix_id'}
+        = $self->latlon_to_tile_with_adjust(
+            @params{'latitude', 'longitude', 'zoom', 'rows', 'cols'});
+
+    $params{x_left_tile} = $params{x_centre_tile} - int($params{cols} / 2);
+    $params{y_top_tile}  = $params{y_centre_tile} - int($params{rows} / 2);
+
+    $params{pins} = [
+        map {
+            my $pin = { %$_ }; # shallow clone
+            ($pin->{px}, $pin->{py})
+                = $self->latlon_to_px($pin->{latitude}, $pin->{longitude},
+                            @params{'x_left_tile', 'y_top_tile', 'zoom'});
+            $pin;
+        } @{ $params{pins} }
+    ];
+
+    my @scales = $self->scales;
+    return {
+        %params,
+        type => $self->map_template,
+        map_type => $self->map_type,
+        tiles => $self->map_tiles( %params ),
+        copyright => $self->copyright(),
+        zoom => $params{zoom},
+        zoomOffset => $self->zoom_parameters->{min_zoom_level},
+        numZoomLevels => $self->zoom_parameters->{zoom_levels},
+        tile_size => $self->tile_parameters->{size},
+        tile_dpi => $self->tile_parameters->{dpi},
+        tile_urls => encode_json( $self->tile_parameters->{urls} ),
+        layer_names => encode_json( $self->tile_parameters->{layer_names} ),
+        map_projection => $self->tile_parameters->{projection},
+        scales => encode_json( \@scales ),
+        %{ $self->_map_hash_extras },
+    };
+}
+
+1;