support mapdeck maps for addFeatures. see SymbolixAU/mapdeck#238

r-spatial · Nov 15, 2019 · 023d0a3 · 023d0a3
1 parent 7341be2
commit 023d0a3
Show file tree

Hide file tree

Showing 2 changed files with 62 additions and 14 deletions.
diff --git a/R/features.R b/R/features.R
@@ -35,7 +35,7 @@ addFeatures <- function(map,
                         pane = "overlayPane",
                         ...) {
 
-  stopifnot(inherits(map, c("leaflet", "leaflet_proxy", "mapview")))
+  stopifnot(inherits(map, c("leaflet", "leaflet_proxy", "mapview", "mapdeck")))
 
   if (inherits(map, "mapview")) {
     if (missing(data)) {
@@ -88,10 +88,14 @@ addFeatures <- function(map,
 mw = 800
 
 ### Point Features
-addPointFeatures <- function(map,
-                             data,
-                             pane,
-                             ...) {
+addPointFeatures = function(map, ...) UseMethod("addPointFeatures")
+
+
+### Point Features leaflet
+addPointFeatures.leaflet <- function(map,
+                                     data,
+                                     pane,
+                                     ...) {
   garnishMap(map, leaflet::addCircleMarkers,
              data = sf::st_zm(sf::st_cast(data, "POINT")),
              popupOptions = leaflet::popupOptions(maxWidth = mw,
@@ -100,11 +104,27 @@ addPointFeatures <- function(map,
              ...)
 }
 
+### Point Features mapdeck
+addPointFeatures.mapdeck <- function(map,
+                                     data,
+                                     ...) {
+  garnishMap(
+    map
+    , mapdeck::add_pointcloud
+    , data = data #sf::st_zm(sf::st_cast(data, "POINT"))
+    , ...
+  )
+}
+
+
 ### Line Features
-addLineFeatures <- function(map,
-                            data,
-                            pane,
-                            ...) {
+addLineFeatures = function(map, ...) UseMethod("addLineFeatures")
+
+### Line Features leaflet
+addLineFeatures.leaflet <- function(map,
+                                    data,
+                                    pane,
+                                    ...) {
   garnishMap(map, leaflet::addPolylines,
              data = sf::st_zm(data),
              popupOptions = leaflet::popupOptions(maxWidth = mw,
@@ -113,11 +133,26 @@ addLineFeatures <- function(map,
              ...)
 }
 
-### PolygonFeatures
-addPolygonFeatures <- function(map,
-                               data,
-                               pane,
-                               ...) {
+### Line Features mapdeck
+addLineFeatures.mapdeck <- function(map,
+                                    data,
+                                    ...) {
+  garnishMap(
+    map
+    , mapdeck::add_path
+    , data = sf::st_zm(data)
+    , ...
+  )
+}
+
+### Polygon Features
+addPolygonFeatures = function(map, ...) UseMethod("addPolygonFeatures")
+
+### Polygon Features leaflet
+addPolygonFeatures.leaflet <- function(map,
+                                       data,
+                                       pane,
+                                       ...) {
   garnishMap(map, leaflet::addPolygons,
              data = sf::st_zm(data),
              popupOptions = leaflet::popupOptions(maxWidth = mw,
@@ -126,6 +161,18 @@ addPolygonFeatures <- function(map,
              ...)
 }
 
+### Polygon Features mapdeck
+addPolygonFeatures.mapdeck <- function(map,
+                                       data,
+                                       ...) {
+  garnishMap(
+    map
+    , mapdeck::add_polygon
+    , data = sf::st_zm(data)
+    , ...
+  )
+}
+
 ### GeometryCollections
 addGeometry = function(map,
                        data,

diff --git a/R/garnish.R b/R/garnish.R
@@ -78,3 +78,4 @@ decorateMap <- function(map, funs, args) {
   }
   return(map)
 }
+