R/measure-path.R

In bhaskarvk/leaflet.extras: Extra Functionality for 'leaflet' Package

measurePathDependencies <- function() {
  list(
    html_dep_prod("lfx-measure-path", "1.5.0", has_style = TRUE, has_binding = TRUE)
  )
}

#' Enables measuring of length of polylines and areas of polygons
#' @param map The map widget.
#' @rdname measure-path
#' @export
#' @examples
#' \donttest{
#' geoJson <- readr::read_file(
#'   "https://rawgit.com/benbalter/dc-maps/master/maps/ward-2012.geojson"
#' )
#'
#' leaflet() %>%
#'   addTiles() %>%
#'   setView(-77.0369, 38.9072, 11) %>%
#'   addBootstrapDependency() %>%
#'   enableMeasurePath() %>%
#'   addGeoJSONChoropleth(
#'     geoJson,
#'     valueProperty = "AREASQMI",
#'     scale = c("white", "red"),
#'     mode = "q",
#'     steps = 4,
#'     padding = c(0.2, 0),
#'     labelProperty = "NAME",
#'     popupProperty = propstoHTMLTable(
#'       props = c("NAME", "AREASQMI", "REP_NAME", "WEB_URL", "REP_PHONE", "REP_EMAIL", "REP_OFFICE"),
#'       table.attrs = list(class = "table table-striped table-bordered"),
#'       drop.na = TRUE
#'     ),
#'     color = "#ffffff", weight = 1, fillOpacity = 0.7,
#'     highlightOptions = highlightOptions(
#'       weight = 2, color = "#000000",
#'       fillOpacity = 1, opacity = 1,
#'       bringToFront = TRUE, sendToBack = TRUE
#'     ),
#'     pathOptions = pathOptions(
#'       showMeasurements = TRUE,
#'       measurementOptions = measurePathOptions(imperial = TRUE)
#'     )
#'   )
#' }
#'
enableMeasurePath <- function(map) {
  map$dependencies <- c(map$dependencies, measurePathDependencies())
  map
}

#' Options for measure-path
#' @param showOnHover If TRUE, the measurements will only show when the user hovers the cursor over the path.
#' @param minPixelDistance The minimum length a line segment in the feature must have for a measurement to be added.
#' @param showDistances If FALSE, doesn't show distances along line segments of of a polyline/polygon.
#' @param showArea If FALSE, doesn't show areas of a polyline/polygon.
#' @param imperial If TRUE the distances/areas will be shown in imperial units.
#' @rdname measure-path
#' @export
measurePathOptions <- function(
    showOnHover = FALSE,
    minPixelDistance = 30,
    showDistances = TRUE,
    showArea = TRUE,
    imperial = FALSE) {
  list(
    showOnHover = showOnHover,
    minPixelDistance = minPixelDistance,
    showDistances = showDistances,
    showArea = showArea,
    imperial = imperial
  )
}

#' Adds a toolbar to enable/disable measuing path distances/areas
#' @param options The measurePathOptions.
#' @rdname measure-path
#' @export
addMeasurePathToolbar <- function(
    map,
    options = measurePathOptions()) {
  map <- enableMeasurePath(map) %>%
    addEasyButtonBar(
      easyButton(
        states = list(
          easyButtonState(
            stateName = "disabled-measurement",
            icon = "ion-ios-flask-outline",
            title = "Enable Measurements",
            onClick = JS("
          function(btn, map) {
             LeafletWidget.methods.enableMeasurements.call(map);
             btn.state(\"enabled-measurement\");

          }")
          ),
          easyButtonState(
            stateName = "enabled-measurement",
            icon = "ion-ios-flask",
            title = "Disable Measurements",
            onClick = JS("
          function(btn, map) {
             LeafletWidget.methods.disableMeasurements.call(map);
             btn.state(\"disabled-measurement\");
          }")
          )
        )
      ),
      easyButton(
        icon = "ion-android-refresh", title = "Recalculate Measurements",
        onClick = JS("function(btn, map){ LeafletWidget.methods.refreshMeasurements.call(map); }")
      )
    )
  invokeMethod(map, leaflet::getMapData(map), "setMeasurementOptions", options)
}