- Initial Support for CRS.

Author: bhaskarvk

NAMESPACE

@@ -52,6 +52,7 @@ export(colorFactor)
 export(colorNumeric)
 export(colorQuantile)
 export(createLeafletMap)
+export(crs)
 export(dispatch)
 export(fitBounds)
 export(hideGroup)

R/leaflet.R

@@ -26,6 +26,13 @@
 #' @export
 leaflet = function(data = NULL, width = NULL, height = NULL,
                    padding = 0, mapOptions = list()) {
+
+  # Validate the CRS if specified
+  if(!is.null(mapOptions[['crs']]) &&
+     !inherits(mapOptions[['crs']], 'leaflet_crs')) {
+    stop("CRS in mapOptions should be a return value of crs() function")
+  }
+
   htmlwidgets::createWidget(
     'leaflet',
     structure(
@@ -76,3 +83,71 @@ mapOptions <- function(map, zoomToLimits = c("always", "first", "never")) {
 
   map
 }
+
+# CRS classes supported
+crsClasses <- list( 'L.CRS.EPSG3857', 'L.CRS.EPSG4326', 'L.CRS.EPSG3395',
+                    'L.CRS.Simple', 'L.Proj.CRS', 'L.Proj.CRS.TMS' )
+
+#' creates a custom CRS
+#' Refer to \url{https://kartena.github.io/Proj4Leaflet/api/} for details.
+#' @param crsClass One of L.CRS.EPSG3857, L.CRS.EPSG4326, L.CRS.EPSG3395,
+#' L.CRS.Simple, L.Proj.CRS, L.Proj.CRS.TMS
+#' @param code CRS identifier
+#' @param proj4def Proj4 string
+#' @param projectedBounds Only when crsClass = 'L.Proj.CRS.TMS'
+#' @param origin Origin in projected coordinates, if set overrides transformation option.
+#' @param transformation to use when transforming projected coordinates into pixel coordinates
+#' @param scales Scale factors (pixels per projection unit, for example pixels/meter)
+#'   for zoom levels; specify either scales or resolutions, not both
+#' @param resolutions factors (projection units per pixel, for example meters/pixel)
+#'   for zoom levels; specify either scales or resolutions, not both
+#' @param bounds Bounds of the CRS, in projected coordinates; if defined,
+#'    Proj4Leaflet will use this in the getSize method, otherwise
+#'    defaulting to Leaflet's default CRS size
+#' @param tileSize Tile size, in pixels, to use in this CRS (Default 256)
+#'    Only needed when crsClass = 'L.Proj.CRS.TMS'
+#' @export
+crs <- function(
+  crsClass = 'L.CRS.EPSG3857',
+  code = NULL,
+  proj4def = NULL,
+  projectedBounds = NULL,
+  origin = NULL,
+  transformation = NULL,
+  scales = NULL,
+  resolutions = NULL,
+  bounds = NULL,
+  tileSize = NULL
+) {
+  if(!crsClass %in% crsClasses) {
+    stop(sprintf("crsClass argument must be one of %s",
+                 paste0(crsClasses, collapse = ', ')))
+
+  }
+  if(crsClass %in% c('L.Proj.CRS', 'L.Proj.CRS.TMS') &&
+    !is.null(scales) && !is.null(resolutions)) {
+    stop(sprintf("Either input scales or resolutions"))
+  }
+  if(crsClass %in% c('L.Proj.CRS', 'L.Proj.CRS.TMS') &&
+    is.null(scales) && is.null(resolutions)) {
+    stop(sprintf("Input either scales or resolutions, not both"))
+  }
+    structure(
+      list(
+        crsClass = crsClass,
+        code = code,
+        proj4def = proj4def,
+        projectedBounds = projectedBounds,
+        options = filterNULL(list(
+          origin = origin,
+          transformation = transformation,
+          scales = scales,
+          resolutions = resolutions,
+          bounds = bounds,
+          tileSize = tileSize
+        ))
+      ),
+      class = 'leaflet_crs'
+  )
+}
+

R/plugin-graticule.R

@@ -14,6 +14,7 @@ leafletGraticuleDependencies <- function() {
 #'
 #' @param map a map widget object
 #' @param interval The spacing in map units between horizontal and vertical lines.
+#' @param sphere boolean. Default FALSE
 #' @param style path options for the generated lines. See \url{http://leafletjs.com/reference.html#path-options}
 #' @param layerId the layer id
 #' @param group the name of the group this layer belongs to.
@@ -28,6 +29,7 @@ leafletGraticuleDependencies <- function() {
 addGraticule <- function(
   map,
   interval = 20,
+  sphere = FALSE,
   style = list(color= '#333', weight= 1),
   layerId = NULL,
   group=NULL
@@ -38,6 +40,7 @@ addGraticule <- function(
     getMapData(map),
     'addGraticule',
     interval,
+    sphere,
     style,
     layerId,
     group

inst/examples/proj4Leaflet.R

@@ -5,9 +5,8 @@ library(leaflet)
 
 
 #' Default SPherical Mercator Projection specified explicitly
-leaflet(mapOptions=list(crs=list('_class'='L.CRS.EPSG3857'),
-                        center=c(0,0),
-                        zoom=3)) %>% addTiles()
+leaflet(mapOptions=list(crs=crs(crsClass='L.CRS.EPSG3857'),
+                        center=c(0,0), zoom=3)) %>% addTiles()
 
 #' <br/><br/>Gothenberg, Sweeden in default projection
 leaflet(mapOptions = list(center=c(57.704, 11.965), zoom = 16)) %>%
@@ -17,14 +16,13 @@ leaflet(mapOptions = list(center=c(57.704, 11.965), zoom = 16)) %>%
 #' <br/><br/>Gothenberg, Sweeden in local projection
 leaflet(mapOptions = list(center=c(57.704, 11.965), zoom = 13,
                            worldCopyJump = FALSE,
-                          crs=list('_class'="L.Proj.CRS", code='EPSG:3006',
+                          crs=crs(crsClass="L.Proj.CRS", code='EPSG:3006',
                                    proj4def='+proj=utm +zone=33 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs',
-                                   options=list(
-                                     resolutions = c(
-                                       8192, 4096, 2048, 1024, 512, 256, 128,
-                                       64, 32, 16, 8, 4, 2, 1, 0.5
-                                     ),
-                                   origin =c(0, 0))))) %>%
+                                   resolutions = c(
+                                     8192, 4096, 2048, 1024, 512, 256, 128,
+                                     64, 32, 16, 8, 4, 2, 1, 0.5
+                                   ),
+                                   origin =c(0, 0)))) %>%
   addTiles(urlTemplate = 'http://api.geosition.com/tile/osm-bright-3006/{z}/{x}/{y}.png',
            attribution = 'Map data &copy; <a href="http://www.openstreetmap.org/copyright">OpenStreetMap contributors</a>, Imagery &copy; 2013 <a href="http://www.kartena.se/">Kartena</a>',
            options = tileOptions(minZoom=0,maxZoom=14,continuousWorld = TRUE))
@@ -42,20 +40,19 @@ sp::proj4string(spdf) # Look MA no need to reproject
 
 leaflet(mapOptions =
           list(maxZoom = 5,
-               worldCopyJump = FALSE,
-               crs=list('_class'="L.Proj.CRS", code='ESRI:53009',
+               crs=crs(crsClass="L.Proj.CRS", code='ESRI:53009',
                         proj4def= '+proj=moll +lon_0=0 +x_0=0 +y_0=0 +a=6371000 +b=6371000 +units=m +no_defs',
-                        options=list(
-                          resolutions = c(65536, 32768, 16384, 8192, 4096, 2048)
-                        )))) %>%
+                        resolutions = c(65536, 32768, 16384, 8192, 4096, 2048)
+                       ))) %>%
   addGraticule(style= list(color= '#999', weight= 0.5, opacity= 1)) %>%
+  addGraticule(sphere = TRUE, style= list(color= '#777', weight= 1, opacity= 0.25)) %>%
   addPolygons(data=spdf, weight = 1, color = "#ff0000")
 
 #' <br/><br/>L.CRS.Simple example.
 #' For now the image is specified via onRender and native JS call
 #' because we haven't coded the L.ImageLayer part yet.
-bounds <- c(0,0,1000,1000)
-leaflet(mapOptions = list(crs=list('_class'='L.CRS.Simple'))) %>%
+bounds <- c(-26.5,-25, 1021.5,1023)
+leaflet(mapOptions = list(crs=crs(crsClass='L.CRS.Simple'), minZoom= -5)) %>%
   fitBounds(bounds[1], bounds[2], bounds[3], bounds[4]) %>%
   setMaxBounds(bounds[1], bounds[2], bounds[3], bounds[4]) %>%
   htmlwidgets::onRender("
@@ -81,14 +78,14 @@ pal <- colorNumeric(
 )
 
 bounds <- c(-125, 24 ,-75, 45)
+
 leaflet(mapOptions =
           list(worldCopyJump = FALSE,
-               crs=list('_class'="L.Proj.CRS", code='EPSG:2163',
+               crs=crs(crsClass="L.Proj.CRS", code='EPSG:2163',
                         proj4def='+proj=laea +lat_0=45 +lon_0=-100 +x_0=0 +y_0=0 +a=6370997 +b=6370997 +units=m +no_defs',
-                        options=list(
-                          resolutions = c(65536, 32768, 16384, 8192, 4096, 2048,
-                                          1024, 512, 256, 128)
-                        )))) %>%
+                        resolutions = c(65536, 32768, 16384, 8192, 4096, 2048,
+                                        1024, 512, 256, 128)
+                        ))) %>%
   fitBounds(bounds[1], bounds[2], bounds[3], bounds[4]) %>%
   setMaxBounds(bounds[1], bounds[2], bounds[3], bounds[4]) %>%
   addPolygons(data=spdf, weight = 1, color = "#000000",

inst/htmlwidgets/leaflet.js

@@ -450,7 +450,7 @@ _htmlwidgets2.default.widget({
           var crs = _leaflet2.default.CRS.EPSG3857; // Default Spherical Mercator
           var crsOptions = data.options.crs;
 
-          switch (crsOptions._class) {
+          switch (crsOptions.crsClass) {
             case "L.CRS.EPSG3857":
               crs = _leaflet2.default.CRS.EPSG3857;
               break;

inst/htmlwidgets/plugins/Leaflet.Graticule/Graticule-binding.js

@@ -1,8 +1,9 @@
-  LeafletWidget.methods.addGraticule = function(interval, style, layerId, group) {
+  LeafletWidget.methods.addGraticule = function(interval, sphere, style, layerId, group) {
     (function() {
       this.layerManager.addLayer(
         L.graticule({
           interval: interval,
+          sphere: sphere,
           style: style
         }),
         'shape', layerId, group);

javascript/src/index.js

@@ -96,7 +96,7 @@ HTMLWidgets.widget({
           let crs = L.CRS.EPSG3857; // Default Spherical Mercator
           let crsOptions = data.options.crs;
 
-          switch(crsOptions._class) {
+          switch(crsOptions.crsClass) {
           case "L.CRS.EPSG3857":
             crs = L.CRS.EPSG3857;
             break;