diff --git a/NAMESPACE b/NAMESPACE index 4c952a5..57c5d0d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,11 +11,15 @@ export(add_popup) export(add_source) export(add_tooltip) export(construct_basemap_style) +export(fullscreen_control) export(geojson_source) +export(geolocate_control) export(layer) export(map_options) export(maplibre) export(maplibreOutput) export(marker_options) +export(navigation_control) export(renderMaplibre) +export(scale_control) import(htmlwidgets) diff --git a/R/add_control.R b/R/add_control.R deleted file mode 100644 index 39e108d..0000000 --- a/R/add_control.R +++ /dev/null @@ -1,22 +0,0 @@ -#' Add a control to a Map widget -#' -#' @param .map A [maplibre()] HTML widget -#' @param control_name The name of the control -#' @param control_position The position of the control. -#' @param ... Control options depending on the type of control. -#' @returns The updated [maplibre()] HTML widget -#' @export -#' -#' @example examples/basemap.R -add_control <- function(.map, control_name = c( - "NavigationControl", - "ScaleControl", "FullscreenControl", - "GeolocateControl", "AttributionControl" - ), - control_position = c("top-left", "top-right", "bottom-left", "bottom-right"), - ...) { - control_name <- match.arg(control_name) - control_position <- match.arg(control_position) - .map |> - add_call("addControl", control_name, list(...), control_position) -} diff --git a/R/controls.R b/R/controls.R new file mode 100644 index 0000000..ba597c6 --- /dev/null +++ b/R/controls.R @@ -0,0 +1,177 @@ +#' Add a control to a Map widget +#' +#' @param .map A [maplibre()] HTML widget +#' @param control_name The name of the control +#' @param control_position The position of the control. +#' @param ... Control options depending on the type of control. +#' @returns The updated [maplibre()] HTML widget +#' @export +#' +#' @example examples/basemap.R +add_control <- function(.map, control_name = c( + "NavigationControl", + "ScaleControl", "FullscreenControl", + "GeolocateControl", "AttributionControl" +), +control_position = c("top-left", "top-right", "bottom-left", "bottom-right"), +...) { + control_name <- match.arg(control_name) + control_position <- match.arg(control_position) + .map |> + add_call("addControl", control_name, list(...), control_position) +} + + +#' Add navigation control to map +#' A NavigationControl control contains zoom buttons and a compass. +#' @inherit add_control params return +#' @param position The position of the control. +#' @param show_compass If TRUE the compass button is included. +#' @param show_zoom If TRUE the zoom-in and zoom-out buttons are included. +#' @param visualize_pitch If TRUE the pitch is visualized by rotating X-axis of compass. +#' +#' @export +#' +#' @example examples/controls.R +navigation_control <- function(.map, + position = c("top-left", "top-right", "bottom-left", "bottom-right"), + show_compass = TRUE, + show_zoom = TRUE, + visualize_pitch = TRUE) { + control_options <- rdantic( + list( + showCompass = show_compass, + showZoom = show_zoom, + visualizePitch = visualize_pitch + ), + TYPES_NAVIGATION_CONTROL_OPTIONS + ) + + control_position <- match.arg(position) + options <- purrr::compact( + c( + control_name = "NavigationControl", control_position = control_position, + control_options + ) + ) + + do.call(add_control, args = list(.map = .map) |> append(options)) +} + + +#' A ScaleControl control displays the ratio of a distance on the map to the corresponding distance on the ground. +#' +#' @inherit add_control params return +#' @inherit navigation_control params +#' @param max_width The maximum length of the scale control in pixels. +#' @param unit Unit of the distance ('imperial', 'metric' or 'nautical'). +#' +#' @export +#' +#' @example examples/controls.R +scale_control <- function(.map, + position = c("top-left", "top-right", "bottom-left", "bottom-right"), + max_width = 100, + unit = c("imperial", "metric", "nautical")) { + control_options <- rdantic( + list( + maxWidth = max_width, + unit = match.arg(unit) + ), + TYPES_SCALE_CONTROL_OPTIONS + ) + + if(length(control_options)==0){ + control_options <- list("") + } + control_position <- match.arg(position) + options <- purrr::compact( + c( + control_name = "ScaleControl", control_position = control_position, + control_options + ) + ) + + do.call(add_control, args = list(.map = .map) |> append(options)) +} + + +#' A GeolocateControl control provides a button that uses the browser's geolocation API to locate the user on the map. +#' +#' @inherit add_control params return +#' @inherit navigation_control params +#' @param show_accuracy_circle By default, if showUserLocation is true, a transparent circle will be drawn around the user location indicating the accuracy (95% confidence level) of the user's location. Set to FALSE to disable. Always disabled when showUserLocation is FALSE. +#' @param show_user_location By default a dot will be shown on the map at the user's location. Set to FALSE to disable. +#' @param track_user_location If TRUE the GeolocateControl becomes a toggle button and when active the map will receive updates to the user's location as it changes. +#' @param fit_bounds_options A options object to use when the map is panned and zoomed to the user's location. The default is to use a maxZoom of 15 to limit how far the map will zoom in for very accurate locations. +#' @param position_options Optional Geolocation APIs options +#' +#' @export +#' +#' @example examples/controls.R +geolocate_control <- function(.map, + position = c("top-left", "top-right", "bottom-left", "bottom-right"), + show_accuracy_circle = FALSE, + show_user_location = FALSE, + track_user_location = FALSE, + fit_bounds_options = NULL, + position_options = NULL){ + + control_options <- c( + rdantic( + list( + showAccuracyCircle = show_accuracy_circle, + showUserLocation = show_user_location, + trackUserLocation = track_user_location + ), + TYPES_GEOLOCATION_CONTROL_OPTIONS + ), + FitBoundsOptions = rdantic( + fit_bounds_options, TYPES_FIT_BOUNDS_OPTIONS + ) + + ) + if(length(control_options)==0){ + control_options <- list("") + } + + control_position <- match.arg(position) + options <- purrr::compact( + c( + control_name = "GeolocateControl", control_position = control_position, + control_options + ) + ) + + do.call(add_control, args = list(.map = .map) |> append(options)) +} + + + +#' A FullscreenControl control contains a button for toggling the map in and out of fullscreen mode +#' +#' @inherit add_control params return +#' @inherit navigation_control params +#' +#' @export +#' +#' @example examples/controls.R +fullscreen_control <- function(.map, + position = c("top-left", "top-right", "bottom-left", "bottom-right"), + ...){ + + control_options <- list(...) + if(length(control_options)==0){ + control_options <- list("") + } + control_position <- match.arg(position) + options <- purrr::compact( + c( + control_name = "FullscreenControl", control_position = control_position, + control_options + ) + ) + + do.call(add_control, args = (list(.map = .map) |> append(options))) + +} diff --git a/R/maplibre.R b/R/maplibre.R index a668f10..d923e7d 100644 --- a/R/maplibre.R +++ b/R/maplibre.R @@ -14,7 +14,7 @@ maplibre <- function(map_options = NULL, deck = FALSE, width = "100%", height = NULL, element_id = NULL, ...) { - if (is.null(map_options)){ + if (is.null(map_options)) { map_options <- map_options() warning("map_options is NULL. Using map_options() with dark-matterhl-style as style.") } @@ -81,30 +81,30 @@ maplibre <- function(map_options = NULL, #' Parameter descriptions are adapted from the Maplibre GL JS Project, please visit the official documentation at \url{https://maplibre.org/maplibre-gl-js/docs/API/type-aliases/MapOptions/} #' @example examples/basemap.R map_options <- function(style = maplibre::basemaps$carto$dark_matter, - antialias = NULL, - attribution_control = NULL, - bearing = NULL, - bearing_snap = NULL, - bounds = NULL, - box_zoom = NULL, - center = NULL, - click_tolerance = NULL, - double_click_zoom = NULL, - fade_duration = NULL, - fit_bounds_options = NULL, - hash = NULL, - interactive = NULL, - keyboard = NULL, - maplibre_logo = NULL, - max_bounds = NULL, - max_pitch = NULL, - max_zoom = NULL, - min_pitch = NULL, - min_zoom = NULL, - pitch = NULL, - scroll_zoom = NULL, - zoom = NULL, - ...) { + antialias = NULL, + attribution_control = NULL, + bearing = NULL, + bearing_snap = NULL, + bounds = NULL, + box_zoom = NULL, + center = NULL, + click_tolerance = NULL, + double_click_zoom = NULL, + fade_duration = NULL, + fit_bounds_options = NULL, + hash = NULL, + interactive = NULL, + keyboard = NULL, + maplibre_logo = NULL, + max_bounds = NULL, + max_pitch = NULL, + max_zoom = NULL, + min_pitch = NULL, + min_zoom = NULL, + pitch = NULL, + scroll_zoom = NULL, + zoom = NULL, + ...) { # BODY options <- rdantic( list( @@ -136,8 +136,7 @@ map_options <- function(style = maplibre::basemaps$carto$dark_matter, ) purrr::compact( c( - options - , + options, list(...) ) ) diff --git a/R/marker.R b/R/marker.R index 86637f8..1662152 100644 --- a/R/marker.R +++ b/R/marker.R @@ -33,7 +33,7 @@ Marker <- function(lng_lat, popup = NULL, ...) { #' #' @example examples/markers.R marker_options <- function(anchor = NULL, color = NULL, pitchAlignment = NULL, rotationAlignment = NULL, - draggable = NULL, rotation = NULL, scale = NULL, ...) { + draggable = NULL, rotation = NULL, scale = NULL, ...) { marker_options <- list(...) stopifnot(sapply(marker_options[c("anchor", "color", "pitchAlignment", "rotationAlignment")], function(x) { is.null(x) | is.character(x) diff --git a/R/types.R b/R/types.R index 5c01ca9..63eea20 100644 --- a/R/types.R +++ b/R/types.R @@ -1,3 +1,6 @@ +# Types #### + +## Basemap Style #### TYPES_BASEMAP_STYLE <- list( name = is.character, version = is.integer, @@ -5,6 +8,7 @@ TYPES_BASEMAP_STYLE <- list( layers = is.list ) +## Layer #### TYPES_LAYER <- list( type = is.character, id = is.character, @@ -15,6 +19,7 @@ TYPES_LAYER <- list( layout = is.list ) +## Map options #### TYPES_MAP_OPTIONS <- list( style = function(x) { is.list(x) | is.character(x) @@ -61,3 +66,41 @@ TYPES_MAP_OPTIONS <- list( is.integer(x) | is.numeric(x) } ) + + +## Navigation control #### + +TYPES_NAVIGATION_CONTROL_OPTIONS <- list( + showCompass = is.logical, + showZoom = is.logical, + visualizePitch = is.logical +) + +## Scale control #### +TYPES_SCALE_CONTROL_OPTIONS <- list( + maxWidth = function(x) { + is.integer(x) | is.numeric(x) + }, + unit = is.character +) + + +## Geolocation control #### + +TYPES_GEOLOCATION_CONTROL_OPTIONS <- list( + showAccuracyCircle = is.logical, + showUserLocation = is.logical, + trackUserLocation = is.logical +) + +TYPES_FIT_BOUNDS_OPTIONS <- list( + linear = is.logical, + maxZoom = function(x){ + is.integer(x) | x == round(x, 0) + }, + offset = function(x){ + (is.integer(x) | is.numeric(x)) & length(x) = 2 + } + +) + diff --git a/R/utils.R b/R/utils.R index 86bbb42..e6564ff 100644 --- a/R/utils.R +++ b/R/utils.R @@ -9,7 +9,7 @@ rdantic <- function(.obj, types, test = 1L) { value <- .obj[[k]] if (!is.null(value)) { if (!type_check(value)) { - stop("Value of '", k , "' (\"",value, "\") failed test: ", deparse(substitute(type_check)), call. = FALSE) + stop("Value of '", k, "' (\"", value, "\") failed test: ", deparse(substitute(type_check)), call. = FALSE) } } } diff --git a/examples/basemap.R b/examples/basemap.R index e5f78cf..a339599 100644 --- a/examples/basemap.R +++ b/examples/basemap.R @@ -3,7 +3,7 @@ map_options <- map_options( hash = TRUE, pitch = 0, style = basemaps$carto$dark_matter - ) +) # add control uses add_call to add a control to the map widget maplibre(map_options, zoom = 12) |> diff --git a/examples/controls.R b/examples/controls.R new file mode 100644 index 0000000..df3db92 --- /dev/null +++ b/examples/controls.R @@ -0,0 +1,40 @@ +# Add Navigation control + +maplibre(map_options()) |> + navigation_control( + position = "top-left", + visualize_pitch = TRUE, + show_compass = TRUE, + show_zoom = TRUE + ) + + +# Add Scale control + +maplibre(map_options()) |> + scale_control( + position = "bottom-left", + max_width = 200, + unit = "metric" + ) +# Add Geolocate control + +maplibre(map_options()) |> + add_control(control_name = "GeolocateControl") + + + +maplibre(map_options()) |> + geolocate_control(position = "bottom-right",show_accuracy_circle = TRUE, show_user_location = TRUE, + track_user_location = TRUE, fit_bounds_options = list(linear = FALSE)) + + +# Add Fullscreen control + +maplibre(map_options()) |> + add_control(control_name = "FullscreenControl",list(NULL), control_position = "bottom-right") + +maplibre(map_options())|> + fullscreen_control(position = "bottom-left") + + diff --git a/examples/layers.R b/examples/layers.R index d78f60f..f0fe8ec 100644 --- a/examples/layers.R +++ b/examples/layers.R @@ -1,5 +1,3 @@ -library(maplibre) - earthquakes_source <- list( type = "geojson", data = "https://docs.mapbox.com/mapbox-gl-js/assets/earthquakes.geojson" diff --git a/examples/sf-source.R b/examples/sf-source.R index a1e5b3f..ddc0ada 100644 --- a/examples/sf-source.R +++ b/examples/sf-source.R @@ -1,4 +1,4 @@ -nc <- sf::st_read(system.file("shape/nc.shp", package="sf")) +nc <- sf::st_read(system.file("shape/nc.shp", package = "sf")) # Wrong CRS bounds <- sf::st_bbox(nc) |> diff --git a/examples/sf.R b/examples/sf.R index 1b2eefe..17263ad 100644 --- a/examples/sf.R +++ b/examples/sf.R @@ -1,4 +1,4 @@ -nc <- sf::st_read(system.file("shape/nc.shp", package="sf")) |> +nc <- sf::st_read(system.file("shape/nc.shp", package = "sf")) |> sf::st_transform("EPSG:4236") # sf::st_crs(nc) diff --git a/man/Layer.Rd b/man/Layer.Rd index f4924e6..cbcf296 100644 --- a/man/Layer.Rd +++ b/man/Layer.Rd @@ -23,8 +23,6 @@ layer(type, id, source = NULL, paint = NULL, layout = NULL, ...) Create a layer } \examples{ -library(maplibre) - earthquakes_source <- list( type = "geojson", data = "https://docs.mapbox.com/mapbox-gl-js/assets/earthquakes.geojson" diff --git a/man/add_call.Rd b/man/add_call.Rd index 42da09d..78f5e01 100644 --- a/man/add_call.Rd +++ b/man/add_call.Rd @@ -25,7 +25,7 @@ map_options <- map_options( hash = TRUE, pitch = 0, style = basemaps$carto$dark_matter - ) +) # add control uses add_call to add a control to the map widget maplibre(map_options, zoom = 12) |> diff --git a/man/add_control.Rd b/man/add_control.Rd index 0e56c05..ed086d1 100644 --- a/man/add_control.Rd +++ b/man/add_control.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_control.R +% Please edit documentation in R/controls.R \name{add_control} \alias{add_control} \title{Add a control to a Map widget} @@ -33,7 +33,7 @@ map_options <- map_options( hash = TRUE, pitch = 0, style = basemaps$carto$dark_matter - ) +) # add control uses add_call to add a control to the map widget maplibre(map_options, zoom = 12) |> diff --git a/man/add_layer.Rd b/man/add_layer.Rd index 53ddb20..82bf2d1 100644 --- a/man/add_layer.Rd +++ b/man/add_layer.Rd @@ -22,8 +22,6 @@ The updated \code{\link[=maplibre]{maplibre()}} HTML widget Add a layer to map } \examples{ -library(maplibre) - earthquakes_source <- list( type = "geojson", data = "https://docs.mapbox.com/mapbox-gl-js/assets/earthquakes.geojson" diff --git a/man/add_popup.Rd b/man/add_popup.Rd index aa686d2..b1ac52d 100644 --- a/man/add_popup.Rd +++ b/man/add_popup.Rd @@ -22,8 +22,6 @@ The updated \code{\link[=maplibre]{maplibre()}} HTML widget Add popup property to layer } \examples{ -library(maplibre) - earthquakes_source <- list( type = "geojson", data = "https://docs.mapbox.com/mapbox-gl-js/assets/earthquakes.geojson" diff --git a/man/add_tooltip.Rd b/man/add_tooltip.Rd index 08606e8..b3a7856 100644 --- a/man/add_tooltip.Rd +++ b/man/add_tooltip.Rd @@ -22,8 +22,6 @@ The updated \code{\link[=maplibre]{maplibre()}} HTML widget Add tooltip property to layer } \examples{ -library(maplibre) - earthquakes_source <- list( type = "geojson", data = "https://docs.mapbox.com/mapbox-gl-js/assets/earthquakes.geojson" diff --git a/man/fullscreen_control.Rd b/man/fullscreen_control.Rd new file mode 100644 index 0000000..2c3f440 --- /dev/null +++ b/man/fullscreen_control.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/controls.R +\name{fullscreen_control} +\alias{fullscreen_control} +\title{A FullscreenControl control contains a button for toggling the map in and out of fullscreen mode} +\usage{ +fullscreen_control( + .map, + position = c("top-left", "top-right", "bottom-left", "bottom-right"), + ... +) +} +\arguments{ +\item{.map}{A \code{\link[=maplibre]{maplibre()}} HTML widget} + +\item{position}{The position of the control.} + +\item{...}{Control options depending on the type of control.} +} +\value{ +The updated \code{\link[=maplibre]{maplibre()}} HTML widget +} +\description{ +A FullscreenControl control contains a button for toggling the map in and out of fullscreen mode +} +\examples{ +# Add Navigation control + +maplibre(map_options()) |> + navigation_control( + position = "top-left", + visualize_pitch = TRUE, + show_compass = TRUE, + show_zoom = TRUE + ) + + +# Add Scale control + +maplibre(map_options()) |> + scale_control( + position = "bottom-left", + max_width = 200, + unit = "metric" + ) +# Add Geolocate control + +maplibre(map_options()) |> + add_control(control_name = "GeolocateControl") + + + +maplibre(map_options()) |> + geolocate_control(position = "bottom-right",show_accuracy_circle = TRUE, show_user_location = TRUE, + track_user_location = TRUE, fit_bounds_options = list(linear = FALSE)) + + +# Add Fullscreen control + +maplibre(map_options()) |> + add_control(control_name = "FullscreenControl",list(NULL), control_position = "bottom-right") + +maplibre(map_options())|> + fullscreen_control(position = "bottom-left") + + +} diff --git a/man/geolocate_control.Rd b/man/geolocate_control.Rd new file mode 100644 index 0000000..29d4440 --- /dev/null +++ b/man/geolocate_control.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/controls.R +\name{geolocate_control} +\alias{geolocate_control} +\title{A GeolocateControl control provides a button that uses the browser's geolocation API to locate the user on the map.} +\usage{ +geolocate_control( + .map, + position = c("top-left", "top-right", "bottom-left", "bottom-right"), + show_accuracy_circle = FALSE, + show_user_location = FALSE, + track_user_location = FALSE, + fit_bounds_options = NULL, + position_options = NULL +) +} +\arguments{ +\item{.map}{A \code{\link[=maplibre]{maplibre()}} HTML widget} + +\item{position}{The position of the control.} + +\item{show_accuracy_circle}{By default, if showUserLocation is true, a transparent circle will be drawn around the user location indicating the accuracy (95\% confidence level) of the user's location. Set to FALSE to disable. Always disabled when showUserLocation is FALSE.} + +\item{show_user_location}{By default a dot will be shown on the map at the user's location. Set to FALSE to disable.} + +\item{track_user_location}{If TRUE the GeolocateControl becomes a toggle button and when active the map will receive updates to the user's location as it changes.} + +\item{fit_bounds_options}{A options object to use when the map is panned and zoomed to the user's location. The default is to use a maxZoom of 15 to limit how far the map will zoom in for very accurate locations.} + +\item{position_options}{Optional Geolocation APIs options} +} +\value{ +The updated \code{\link[=maplibre]{maplibre()}} HTML widget +} +\description{ +A GeolocateControl control provides a button that uses the browser's geolocation API to locate the user on the map. +} +\examples{ +# Add Navigation control + +maplibre(map_options()) |> + navigation_control( + position = "top-left", + visualize_pitch = TRUE, + show_compass = TRUE, + show_zoom = TRUE + ) + + +# Add Scale control + +maplibre(map_options()) |> + scale_control( + position = "bottom-left", + max_width = 200, + unit = "metric" + ) +# Add Geolocate control + +maplibre(map_options()) |> + add_control(control_name = "GeolocateControl") + + + +maplibre(map_options()) |> + geolocate_control(position = "bottom-right",show_accuracy_circle = TRUE, show_user_location = TRUE, + track_user_location = TRUE, fit_bounds_options = list(linear = FALSE)) + + +# Add Fullscreen control + +maplibre(map_options()) |> + add_control(control_name = "FullscreenControl",list(NULL), control_position = "bottom-right") + +maplibre(map_options())|> + fullscreen_control(position = "bottom-left") + + +} diff --git a/man/map_options.Rd b/man/map_options.Rd index de1a5d5..e6d95cb 100644 --- a/man/map_options.Rd +++ b/man/map_options.Rd @@ -95,7 +95,7 @@ map_options <- map_options( hash = TRUE, pitch = 0, style = basemaps$carto$dark_matter - ) +) # add control uses add_call to add a control to the map widget maplibre(map_options, zoom = 12) |> diff --git a/man/maplibre.Rd b/man/maplibre.Rd index 4fe2851..553516c 100644 --- a/man/maplibre.Rd +++ b/man/maplibre.Rd @@ -5,7 +5,7 @@ \title{Create a Map Object for MapLibre GL} \usage{ maplibre( - map_options = map_options(), + map_options = NULL, deck = FALSE, width = "100\%", height = NULL, @@ -33,7 +33,7 @@ map_options <- map_options( hash = TRUE, pitch = 0, style = basemaps$carto$dark_matter - ) +) # add control uses add_call to add a control to the map widget maplibre(map_options, zoom = 12) |> diff --git a/man/navigation_control.Rd b/man/navigation_control.Rd new file mode 100644 index 0000000..ed390ea --- /dev/null +++ b/man/navigation_control.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/controls.R +\name{navigation_control} +\alias{navigation_control} +\title{Add navigation control to map +A NavigationControl control contains zoom buttons and a compass.} +\usage{ +navigation_control( + .map, + position = c("top-left", "top-right", "bottom-left", "bottom-right"), + show_compass = TRUE, + show_zoom = TRUE, + visualize_pitch = TRUE +) +} +\arguments{ +\item{.map}{A \code{\link[=maplibre]{maplibre()}} HTML widget} + +\item{position}{The position of the control.} + +\item{show_compass}{If TRUE the compass button is included.} + +\item{show_zoom}{If TRUE the zoom-in and zoom-out buttons are included.} + +\item{visualize_pitch}{If TRUE the pitch is visualized by rotating X-axis of compass.} +} +\value{ +The updated \code{\link[=maplibre]{maplibre()}} HTML widget +} +\description{ +Add navigation control to map +A NavigationControl control contains zoom buttons and a compass. +} +\examples{ +# Add Navigation control + +maplibre(map_options()) |> + navigation_control( + position = "top-left", + visualize_pitch = TRUE, + show_compass = TRUE, + show_zoom = TRUE + ) + + +# Add Scale control + +maplibre(map_options()) |> + scale_control( + position = "bottom-left", + max_width = 200, + unit = "metric" + ) +# Add Geolocate control + +maplibre(map_options()) |> + add_control(control_name = "GeolocateControl") + + + +maplibre(map_options()) |> + geolocate_control(position = "bottom-right",show_accuracy_circle = TRUE, show_user_location = TRUE, + track_user_location = TRUE, fit_bounds_options = list(linear = FALSE)) + + +# Add Fullscreen control + +maplibre(map_options()) |> + add_control(control_name = "FullscreenControl",list(NULL), control_position = "bottom-right") + +maplibre(map_options())|> + fullscreen_control(position = "bottom-left") + + +} diff --git a/man/scale_control.Rd b/man/scale_control.Rd new file mode 100644 index 0000000..2ff4700 --- /dev/null +++ b/man/scale_control.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/controls.R +\name{scale_control} +\alias{scale_control} +\title{A ScaleControl control displays the ratio of a distance on the map to the corresponding distance on the ground.} +\usage{ +scale_control( + .map, + position = c("top-left", "top-right", "bottom-left", "bottom-right"), + max_width = 100, + unit = c("imperial", "metric", "nautical") +) +} +\arguments{ +\item{.map}{A \code{\link[=maplibre]{maplibre()}} HTML widget} + +\item{position}{The position of the control.} + +\item{max_width}{The maximum length of the scale control in pixels.} + +\item{unit}{Unit of the distance ('imperial', 'metric' or 'nautical').} +} +\value{ +The updated \code{\link[=maplibre]{maplibre()}} HTML widget +} +\description{ +A ScaleControl control displays the ratio of a distance on the map to the corresponding distance on the ground. +} +\examples{ +# Add Navigation control + +maplibre(map_options()) |> + navigation_control( + position = "top-left", + visualize_pitch = TRUE, + show_compass = TRUE, + show_zoom = TRUE + ) + + +# Add Scale control + +maplibre(map_options()) |> + scale_control( + position = "bottom-left", + max_width = 200, + unit = "metric" + ) +# Add Geolocate control + +maplibre(map_options()) |> + add_control(control_name = "GeolocateControl") + + + +maplibre(map_options()) |> + geolocate_control(position = "bottom-right",show_accuracy_circle = TRUE, show_user_location = TRUE, + track_user_location = TRUE, fit_bounds_options = list(linear = FALSE)) + + +# Add Fullscreen control + +maplibre(map_options()) |> + add_control(control_name = "FullscreenControl",list(NULL), control_position = "bottom-right") + +maplibre(map_options())|> + fullscreen_control(position = "bottom-left") + + +} diff --git a/tests/testthat/test-controls.R b/tests/testthat/test-controls.R new file mode 100644 index 0000000..694bad4 --- /dev/null +++ b/tests/testthat/test-controls.R @@ -0,0 +1,177 @@ +test_that("navigation control", { + # prepare + + # act + m0 <- maplibre(map_options()) |> + navigation_control(position = "top-left", visualize_pitch = TRUE, show_compass = FALSE, show_zoom = FALSE) + + m1 <- maplibre(map_options()) |> + navigation_control(position = "bottom-right", visualize_pitch = FALSE, show_compass = TRUE, show_zoom = FALSE) + + m2 <- maplibre(map_options()) |> + navigation_control(position = "bottom-left", visualize_pitch = FALSE, show_compass = FALSE, show_zoom = TRUE) + + # assert + expect_equal( + m0$x$calls, + list( + list( + "addControl", + list( + "NavigationControl", + list( + showCompass = FALSE, + showZoom = FALSE, + visualizePitch = TRUE + ), + "top-left" + ) + ) + ) + ) + + expect_equal( + m1$x$calls, + list( + list( + "addControl", + list( + "NavigationControl", + list( + showCompass = TRUE, + showZoom = FALSE, + visualizePitch = FALSE + ), + "bottom-right" + ) + ) + ) + ) + + expect_equal( + m2$x$calls, + list( + list( + "addControl", + list( + "NavigationControl", + list( + showCompass = FALSE, + showZoom = TRUE, + visualizePitch = FALSE + ), + "bottom-left" + ) + ) + ) + ) + + expect_s3_class(m0, c("maplibre", "htmlwidget")) + expect_s3_class(m1, c("maplibre", "htmlwidget")) + expect_s3_class(m2, c("maplibre", "htmlwidget")) +}) + + +test_that("scale control", { + m0 <- maplibre(map_options()) |> + scale_control( + position = "top-left", + max_width = 200, + unit = "metric" + ) + m1 <- maplibre(map_options()) |> + scale_control( + position = "bottom-right", + max_width = 100, + unit = "imperial" + ) + + expect_equal( + m0$x$calls, + list( + list( + "addControl", + list( + "ScaleControl", + list( + maxWidth = 200, + unit = "metric" + ), + "top-left" + ) + ) + ) + ) + + expect_equal( + m1$x$calls, + list( + list( + "addControl", + list( + "ScaleControl", + list( + maxWidth = 100, + unit = "imperial" + ), + "bottom-right" + ) + ) + ) + ) + expect_s3_class(m0, c("maplibre", "htmlwidget")) + expect_s3_class(m1, c("maplibre", "htmlwidget")) +}) + + +test_that("geolocator control", { + m0 <- maplibre(map_options()) |> + geolocate_control(position = "top-left", + show_accuracy_circle = T, + show_user_location = T, + track_user_location = T, + fit_bounds_options = list(list(linear = T))) + + expect_equal( + m0$x$calls, + list( + list( + "addControl", + list( + "GeolocateControl", + list( + showAccuracyCircle = TRUE, + showUserLocation = TRUE, + trackUserLocation = TRUE, + FitBoundsOptions = list(linear = TRUE) + ), + "top-left" + ) + ) + ) + ) + + expect_s3_class(m0, c("maplibre", "htmlwidget")) +}) + + +test_that("fullscreen_control", { + m0 <- maplibre(map_options()) |> + fullscreen_control(position = "top-left") + + expect_equal( + m0$x$calls, + list( + list( + "addControl", + list( + "FullscreenControl", + list(""), + "top-left" + ) + ) + ) + ) + + expect_s3_class(m0, c("maplibre", "htmlwidget")) +}) diff --git a/tests/testthat/test-maplibre.R b/tests/testthat/test-maplibre.R index e23a950..2aed58d 100644 --- a/tests/testthat/test-maplibre.R +++ b/tests/testthat/test-maplibre.R @@ -9,6 +9,6 @@ test_that("base map", { expect_equal(m$x$mapOptions, list(style = "https://basemaps.cartocdn.com/gl/dark-matter-gl-style/style.json")) expect_equal(m0$x$mapOptions, list(style = "https://basemaps.cartocdn.com/gl/dark-matter-gl-style/style.json")) - expect_s3_class(m, c("maplibre","htmlwidget")) - expect_s3_class(m0, c("maplibre","htmlwidget")) + expect_s3_class(m, c("maplibre", "htmlwidget")) + expect_s3_class(m0, c("maplibre", "htmlwidget")) }) diff --git a/vignettes/articles/layers.Rmd b/vignettes/articles/layers.Rmd index 2a5d0a6..7e57581 100644 --- a/vignettes/articles/layers.Rmd +++ b/vignettes/articles/layers.Rmd @@ -14,7 +14,7 @@ library(maplibre) ``` ```{r} -nc <- sf::st_read(system.file("shape/nc.shp", package="sf")) |> +nc <- sf::st_read(system.file("shape/nc.shp", package = "sf")) |> sf::st_transform("EPSG:4236") # sf::st_crs(nc) @@ -49,7 +49,7 @@ nc_layer <- layer( type = "fill", id = "nc", source = nc_source, - paint = list("fill-color" = "steelblue", "fill-outline-color" = "darkred" ) + paint = list("fill-color" = "steelblue", "fill-outline-color" = "darkred") ) maplibre(map_options(style = basemaps$carto$voyager, bounds = bounds)) |>