WIP: Fix labels/border/remove/clear-instances, **Src-functions, etc..

DESCRIPTION

@@ -29,7 +29,7 @@ Description: Provides bindings to the 'Leaflet.glify' JavaScript library which e
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: false
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Imports:
   geojsonsf,
   htmltools,
@@ -40,4 +40,5 @@ Imports:
 Suggests:
   colourvalues,
   shiny,
+  yyjsonr,
   testthat (>= 2.1.0)

NAMESPACE

@@ -26,6 +26,7 @@ S3method(makePopup,shiny.tag)
 export(addGlPoints)
 export(addGlPolygons)
 export(addGlPolylines)
+export(clearGlGroup)
 export(clearGlLayers)
 export(leafglOutput)
 export(makeColorMatrix)
@@ -37,5 +38,6 @@ export(renderLeafgl)
 importFrom(htmltools,htmlDependencies)
 importFrom(htmltools,tagList)
 importFrom(htmltools,tags)
+importFrom(leaflet,evalFormula)
 importFrom(leaflet,leafletOutput)
 importFrom(leaflet,renderLeaflet)

NEWS

@@ -2,14 +2,33 @@ leafgl 0.2.1.9005 (2023-09-08)
 
 features and improvements
 
+ * New method *clearGlGroup* removes a group from leaflet and the Leaflet.Glify instances.
+ * The JavaScript methods of the `removeGl**` functions was rewritten to correctly remove an element identified by `layerId`
+ * `clearGlLayers` now correctly removes all Leaflet.Glify instances
+ * When showing/hiding Leaflet.Glify layers, they are set to active = TRUE/FALSE to make mouseevents work again. #48, #50
+
 bug fixes
 
   * src version now works also in shiny. #71
+  * added `popupOptions` and `labelOptions`. #83
+  * added `stroke` (default=TRUE) in `addGlPolygons` and `addGlPolygonsSrc` for drawing borders. #3
+  * Labels work similar to `leaflet`. `leafgl` accepts a single string, a vector of strings or a formula. #78
+  * The `...` arguments are now passed to all methods in the underlying library. This allows us to set
+    additional arguments like `fragmentShaderSource`, `sensitivity` or `sensitivityHover`.
 
 documentation etc
 
+ * Added some @details for Shiny click and mouseover events and their corresponding input. #77
+ * Use `@inheritParams leaflet::**` for identical function arguments
+
 miscellaneous
 
+ * unified / simplified the dependency functions/calls
+ * add option `leafgl_json_parser` to change JSON-parser via options. Possible values are:
+    - `jsonify` (default)
+    - `yyjsonr`
+    - Custom JSON converter like `jsonlite::toJSON` for example.
+
 
 leafgl 0.2.1
 

R/glify-helpers.R

@@ -1,31 +1,16 @@
-# helpers
-glifyDependencies = function() {
+# dependencies
+glifyDependencies = function(src = FALSE) {
+  src <- ifelse(src, "Src", "")
   list(
     htmltools::htmlDependency(
       "Leaflet.glify",
       '3.2.0',
       system.file("htmlwidgets/Leaflet.glify", package = "leafgl"),
       script = c(
-        "addGlifyPoints.js"
-        , "addGlifyPolygons.js"
-        , "addGlifyPolylines.js"
-        , "glify-browser.js"
-      )
-    )
-  )
-}
-
-# helpers
-glifyDependenciesSrc = function() {
-  list(
-    htmltools::htmlDependency(
-      "Leaflet.glifySrc",
-      '3.2.0',
-      system.file("htmlwidgets/Leaflet.glify", package = "leafgl"),
-      script = c(
-        "addGlifyPointsSrc.js"
-        , "addGlifyPolygonsSrc.js"
-        , "addGlifyPolylinesSrc.js"
+        "GlifyUtils.js"
+        , paste0("addGlifyPoints", src, ".js")
+        , paste0("addGlifyPolygons", src, ".js")
+        , paste0("addGlifyPolylines", src, ".js")
         , "glify-browser.js"
       )
     )
@@ -56,101 +41,123 @@ glifyDataAttachmentSrc = function(fl_data, group, async = FALSE) {
   }
 }
 
-glifyColorAttachmentSrc = function(fl_color, group) {
-  data_dir <- dirname(fl_color)
-  data_file <- basename(fl_color)
-  list(
-    htmltools::htmlDependency(
-      name = paste0(group, "col"),
-      version = 1,
-      src = c(file = data_dir),
-      script = list(data_file)
-    )
-  )
-}
-
-glifyPopupAttachmentSrc = function(fl_popup, group) {
-  data_dir <- dirname(fl_popup)
-  data_file <- basename(fl_popup)
-  list(
-    htmltools::htmlDependency(
-      name = paste0(group, "pop"),
-      version = 1,
-      src = c(file = data_dir),
-      script = list(data_file)
-    )
-  )
-}
-
-glifyRadiusAttachmentSrc = function(fl_radius, group) {
-  data_dir <- dirname(fl_radius)
-  data_file <- basename(fl_radius)
+glifyAttachmentSrc <- function(fl, group, type) {
+  valid_types <- c("col", "pop", "lab", "rad")
+  if (!type %in% valid_types) {
+    stop("Invalid type. Valid types are: col, pop, lab, rad.")
+  }
+  data_dir <- dirname(fl)
+  data_file <- basename(fl)
   list(
     htmltools::htmlDependency(
-      name = paste0(group, "rad"),
+      name = paste0(group, type),
       version = 1,
       src = c(file = data_dir),
       script = list(data_file)
     )
   )
 }
 
-glifyDataAttachment = function(fl_data, group) {
-  data_dir <- dirname(fl_data)
-  data_file <- basename(fl_data)
-  list(
-    htmltools::htmlDependency(
-      name = paste0(group, "dt"),
-      version = 1,
-      src = c(file = data_dir),
-      attachment = list(data_file)
-    )
-  )
-}
-
 
-glifyColorAttachment = function(fl_color, group) {
-  data_dir <- dirname(fl_color)
-  data_file <- basename(fl_color)
-  list(
-    htmltools::htmlDependency(
-      name = paste0(group, "cl"),
-      version = 1,
-      src = c(file = data_dir),
-      attachment = list(data_file)
-    )
-  )
+# helpers
+json_funccall <- function() {
+  json_parser <- getOption("leafgl_json_parser", "jsonify")  # Default to jsonify
+  if (is.function(json_parser)) {
+    json_parser
+  } else if (json_parser == "yyjsonr") {
+    yyjsonr::write_json_str
+  } else {
+    jsonify::to_json
+  }
 }
-
-glifyPopupAttachment = function(fl_popup, group) {
-  data_dir <- dirname(fl_popup)
-  data_file <- basename(fl_popup)
-  list(
-    htmltools::htmlDependency(
-      name = paste0(group, "pop"),
-      version = 1,
-      src = c(file = data_dir),
-      attachment = list(data_file)
-    )
-  )
+convert_to_json <- function(data, ...) {
+  json_parser <- getOption("leafgl_json_parser", "jsonify")  # Default to jsonify
+  if (is.function(json_parser)) {
+    # print("I am using a custom JSON parser function")
+    json_data <- json_parser(data, ...)
+  } else if (json_parser == "yyjsonr") {
+    # print("I am using yyjsonr")
+    json_data <- yyjsonr::write_json_str(data, ...)
+    class(json_data) <- "json"
+  } else {
+    # print("I am using jsonify")
+    json_data <- jsonify::to_json(data, ...)
+  }
+  return(json_data)
 }
 
 
 
+## Not used ##########
+# glifyDependenciesFl = function() {
+#   list(
+#     htmltools::htmlDependency(
+#       "Leaflet.glify",
+#       '2.2.0',
+#       system.file("htmlwidgets/Leaflet.glify", package = "leafgl"),
+#       script = c(
+#         "GlifyUtils.js"
+#         , "addGlifyPoints.js"
+#         , "addGlifyPolygonsFl.js"
+#         , "addGlifyPolylines.js"
+#         , "glify-browser.js"
+#       )
+#     )
+#   )
+# }
+# glifyDataAttachment = function(fl_data, group) {
+#   data_dir <- dirname(fl_data)
+#   data_file <- basename(fl_data)
+#   list(
+#     htmltools::htmlDependency(
+#       name = paste0(group, "dt"),
+#       version = 1,
+#       src = c(file = data_dir),
+#       attachment = list(data_file)
+#     )
+#   )
+# }
+# glifyColorAttachment = function(fl_color, group) {
+#   data_dir <- dirname(fl_color)
+#   data_file <- basename(fl_color)
+#   list(
+#     htmltools::htmlDependency(
+#       name = paste0(group, "cl"),
+#       version = 1,
+#       src = c(file = data_dir),
+#       attachment = list(data_file)
+#     )
+#   )
+# }
+# glifyPopupAttachment = function(fl_popup, group) {
+#   data_dir <- dirname(fl_popup)
+#   data_file <- basename(fl_popup)
+#   list(
+#     htmltools::htmlDependency(
+#       name = paste0(group, "pop"),
+#       version = 1,
+#       src = c(file = data_dir),
+#       attachment = list(data_file)
+#     )
+#   )
+# }
 
-# helpers
-glifyDependenciesFl = function() {
-  list(
-    htmltools::htmlDependency(
-      "Leaflet.glify",
-      '2.2.0',
-      system.file("htmlwidgets/Leaflet.glify", package = "leafgl"),
-      script = c(
-        "addGlifyPoints.js"
-        , "addGlifyPolygonsFl.js"
-        , "addGlifyPolylines.js"
-        , "glify.js"
-      )
-    )
-  )
-}
+## Not used as its not faster - Needs geometries to be the last column and be named geometry
+# yyjsonr_2_geojson <- function(sfdata) {
+#   geom_col <- attr(sfdata, "sf_column")
+#   # Rename the geometry column to "geometry" if it's not already named "geometry"
+#   colndat <- names(sfdata)
+#   if (geom_col != "geometry") {
+#     colndat[colndat == geom_col] <- "geometry"
+#   }
+#   # Move the geometry column to the last position if it's not already the last column
+#   col_order <- setdiff(colndat, "geometry")
+#   sfdata <- sfdata[, c(col_order, "geometry")]
+#   json_data <- yyjsonr::write_json_str(sfdata, digits=4)
+#   json_data <- gsub("]}]", "]}}]}", fixed = TRUE,
+#                     paste0('{"type":"FeatureCollection","features":[{"type":"Feature","properties":',
+#                            gsub('","geometry":', '"},"geometry":{"type":"Polygon","coordinates":',
+#                                 substr(json_data, 2, nchar(json_data)), fixed = TRUE)))
+#   class(json_data) <- "geojson"
+#   json_data
+# }