Add support for other types of providers

NEWS.md

@@ -8,6 +8,8 @@
     -   `IDErioja.Relieve`
     -   `IDErioja.Claro`
     -   `IDErioja.Oscuro`
+-   `esp_getTiles()` now supports non-OGC compliant WMTS providers, such as
+    Stamen or OpenStreetMaps (see examples).
 
 # mapSpain 0.7.0
 

R/esp_getTiles.R

@@ -143,6 +143,17 @@
 #'
 #' autoplot(custom_wmts_tile) +
 #'   geom_sf(data = segovia, fill = NA, color = "white", linewidth = 2)
+#'
+#' # Example from https://leaflet-extras.github.io/leaflet-providers/preview/
+#' stamen_water <- list(
+#'   id = "Stamen_Water",
+#'   q = "https://stamen-tiles-b.a.ssl.fastly.net/watercolor/{z}/{x}/{y}.jpg"
+#' )
+#'
+#' stamen <- esp_getTiles(segovia, stamen_water, zoommin = 1)
+#'
+#' autoplot(stamen) +
+#'   geom_sf(data = segovia, fill = NA, color = "white", linewidth = 1)
 #' }
 esp_getTiles <- function(x,
                          type = "IDErioja",
@@ -239,12 +250,12 @@ esp_getTiles <- function(x,
   url_pieces <- modifyList(url_pieces, list(attribution = NULL))
 
   # Get type of service
-  typeprov <- toupper(url_pieces$service)
-
-  # Case of IDErioja
-
-  if (grepl("iderioja", type, ignore.case = TRUE)) typeprov <- "WMTS"
-
+  if (is.null(url_pieces$service)) {
+    # On null we assume WMTS, case of non INSPIRE serves OSM)
+    typeprov <- "WMTS"
+  } else {
+    typeprov <- toupper(url_pieces$service)
+  }
   # Add options
   if (is.list(options)) {
     names(options) <- tolower(names(options))
@@ -289,7 +300,7 @@ esp_getTiles <- function(x,
 
   # Get CRS of Tile
   crs <- unlist(url_pieces[names(url_pieces) %in% c("crs", "srs", "tilematrixset")])
-  # Caso IDErioja
+  # Caso some WMTS
   if (is.null(crs)) crs <- "epsg:3857"
 
   if (tolower(crs) == tolower("GoogleMapsCompatible")) crs <- "epsg:3857"
@@ -445,6 +456,10 @@ esp_hlp_get_bbox <- function(x, bbox_expand = 0.05, typeprov = "WMS") {
 esp_hlp_split_url <- function(url_static) {
   split <- unlist(strsplit(url_static, "?", fixed = TRUE))
 
+  if (length(split) == 1) {
+    return(list(q = split))
+  }
+
   urlsplit <- list()
   urlsplit$q <- paste0(split[1], "?")
 

R/esp_get_grid_EEA.R

@@ -138,7 +138,7 @@ esp_get_grid_EEA <- function(resolution = 100,
   }
 
   err_onload <- try(
-    data_sf <- sf::st_read(
+    sf::st_read(
       init_grid,
       quiet = isFALSE(verbose),
       stringsAsFactors = FALSE

R/esp_get_grid_ESDAC.R

@@ -135,7 +135,7 @@ esp_get_grid_ESDAC <- function(resolution = 10,
   }
 
   err_onload <- try(
-    data_sf <- sf::st_read(
+    sf::st_read(
       init_grid,
       quiet = isFALSE(verbose),
       stringsAsFactors = FALSE

R/esp_get_grid_MTN.R

@@ -208,7 +208,7 @@ esp_get_grid_MTN <- function(grid = "MTN25_ETRS89_Peninsula_Baleares_Canarias",
   }
 
   err_onload <- try(
-    data_sf <- sf::st_read(
+    sf::st_read(
       gpkgpath,
       quiet = isFALSE(verbose),
       stringsAsFactors = FALSE

R/utils_download_sianedata.R

@@ -79,7 +79,7 @@ esp_hlp_dwnload_sianedata <- function(api_entry, filename, cache_dir,
   # Load
 
   err_onload <- try(
-    data_sf <- sf::st_read(
+    sf::st_read(
       filepath,
       quiet = isFALSE(verbose),
       stringsAsFactors = FALSE

R/utils_siane.R

@@ -147,7 +147,7 @@ esp_hlp_download_siane <- function(type,
   # Load
 
   err_onload <- try(
-    data_sf <- sf::st_read(
+    sf::st_read(
       filepath,
       quiet = isFALSE(verbose),
       stringsAsFactors = FALSE

R/utils_tiles.R

@@ -175,15 +175,17 @@ getwmts <- function(newbbox,
   }
 
   # get tile list
-  tile_grid <-
-    slippymath::bbox_to_tile_grid(bbox = bbx, zoom = as.numeric(zoom))
+  tile_grid <- slippymath::bbox_to_tile_grid(
+    bbox = bbx,
+    zoom = as.numeric(zoom)
+  )
 
   # Compose
-  ext <- tolower(gsub("image/", "", url_pieces$format))
-
-  # Special case for iderioja
-  if (grepl("iderioja", type, ignore.case = TRUE)) {
+  # Special case for non INSPIRE serves
+  if (is.null(url_pieces$format)) {
     ext <- tools::file_ext(url_pieces$q)
+  } else {
+    ext <- tolower(gsub("image/", "", url_pieces$format))
   }
 
 
@@ -198,7 +200,6 @@ getwmts <- function(newbbox,
     )
   }
 
-
   url_pieces$tilematrixset <- "GoogleMapsCompatible"
   url_pieces$tilematrix <- "{z}"
   url_pieces$tilerow <- "{y}"
@@ -207,8 +208,8 @@ getwmts <- function(newbbox,
   q <- url_pieces$q
   rest <- url_pieces[names(url_pieces) != "q"]
 
-  # Special case iderioja
-  if (grepl("rts.larioja", url_pieces$q, ignore.case = TRUE)) {
+  # Special case WMTS
+  if (isFALSE(grepl("?", url_pieces$q, fixed = TRUE))) {
     q <- url_pieces$q
     crs <- "epsg:3857"
   } else {