673 lines
20 KiB
R
673 lines
20 KiB
R
#' Create a minimal basemap style
|
|
#'
|
|
#' @description
|
|
#' Creates a minimal style with uniform land color, hiding roads, buildings,
|
|
#' and most labels. Ideal for data visualization overlays.
|
|
#'
|
|
#' @param land Character. Color for all land features. Default is "#f8f8f8".
|
|
#' @param water Character. Color for water features. Default is "#e0e8f0".
|
|
#' @param labels Logical. Whether to show city labels. Default is FALSE.
|
|
#' @param label_color Character. Color for labels if shown. Default is "#666666".
|
|
#'
|
|
#' @return A list with `colors` and `labelRules` components to pass to
|
|
#' \code{\link{addProtomaps}}.
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' library(leaflet)
|
|
#' library(protomapr)
|
|
#'
|
|
#' # Ultra-minimal basemap
|
|
#' style <- pmMinimal()
|
|
#' leaflet() %>%
|
|
#' setView(lng = -122.4, lat = 37.8, zoom = 10) %>%
|
|
#' addProtomaps(url = protomaps_url(), style = style)
|
|
#'
|
|
#' # Custom colors with major city labels
|
|
#' style <- pmMinimal(land = "#f5f5f0", water = "#1a3a5c", labels = TRUE)
|
|
#' leaflet() %>%
|
|
#' setView(lng = -122.4, lat = 37.8, zoom = 8) %>%
|
|
#' addProtomaps(url = protomaps_url(), style = style)
|
|
#' }
|
|
#'
|
|
#' @seealso \code{\link{pmStyle}}, \code{\link{addProtomaps}}
|
|
#' @export
|
|
pmMinimal <- function(land = "#f8f8f8",
|
|
water = "#e0e8f0",
|
|
labels = FALSE,
|
|
label_color = "#666666") {
|
|
|
|
colors <- pmColors(
|
|
background = land,
|
|
earth = land,
|
|
water = water,
|
|
# Land use - all same as land
|
|
park = land,
|
|
wood = land,
|
|
scrub_a = land,
|
|
scrub_b = land,
|
|
glacier = land,
|
|
sand = land,
|
|
beach = land,
|
|
hospital = land,
|
|
school = land,
|
|
industrial = land,
|
|
pedestrian = land,
|
|
zoo = land,
|
|
military = land,
|
|
aerodrome = land,
|
|
# Roads - hidden
|
|
highway = land,
|
|
major = land,
|
|
medium = land,
|
|
minor = land,
|
|
link = land,
|
|
other = land,
|
|
railway = land,
|
|
pier = land,
|
|
boundary = land,
|
|
# Buildings - hidden
|
|
buildings = land
|
|
)
|
|
|
|
labelRules <- list()
|
|
if (labels) {
|
|
labelRules <- list(
|
|
# Major cities only
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "500 12px sans-serif",
|
|
fill = label_color,
|
|
stroke = land,
|
|
width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom <= 6")
|
|
)
|
|
}
|
|
|
|
structure(
|
|
list(colors = colors, labelRules = labelRules),
|
|
class = "pm_style"
|
|
)
|
|
}
|
|
|
|
|
|
#' Get a preset map style
|
|
#'
|
|
#' @description
|
|
#' Returns a preset style configuration. Available presets provide common
|
|
#' styling patterns without manual configuration.
|
|
#'
|
|
#' @param name Character. Name of the preset style. One of:
|
|
#' \describe{
|
|
#' \item{"minimal"}{Light gray land, light blue water, no labels}
|
|
#' \item{"minimal-dark"}{Dark land, dark blue water, no labels}
|
|
#' \item{"muted"}{Subtle colors, faint roads, major labels only}
|
|
#' \item{"watercolor"}{Soft, painterly aesthetic}
|
|
#' \item{"ink"}{Black lines on white, like a pen drawing}
|
|
#' \item{"terrain"}{Earthy tones with subtle elevation feel}
|
|
#' \item{"transit"}{Muted base with emphasized rail lines}
|
|
#' }
|
|
#'
|
|
#' @return A list with style components to pass to \code{\link{addProtomaps}}.
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' library(leaflet)
|
|
#' library(protomapr)
|
|
#'
|
|
#' leaflet() %>%
|
|
#' setView(lng = -122.4, lat = 37.8, zoom = 10) %>%
|
|
#' addProtomaps(url = protomaps_url(), style = pmStyle("minimal"))
|
|
#'
|
|
#' leaflet() %>%
|
|
#' setView(lng = -122.4, lat = 37.8, zoom = 10) %>%
|
|
#' addProtomaps(url = protomaps_url(), style = pmStyle("watercolor"))
|
|
#' }
|
|
#'
|
|
#' @seealso \code{\link{pmMinimal}}, \code{\link{addProtomaps}}
|
|
#' @export
|
|
pmStyle <- function(name = c("minimal", "minimal-dark", "muted", "watercolor",
|
|
"ink", "terrain", "transit")) {
|
|
name <- match.arg(name)
|
|
|
|
switch(name,
|
|
"minimal" = pmMinimal(),
|
|
|
|
"minimal-dark" = pmMinimal(land = "#1a1a1a", water = "#0d1520", label_color = "#888888"),
|
|
|
|
"muted" = {
|
|
colors <- pmColors(
|
|
background = "#fafafa",
|
|
earth = "#fafafa",
|
|
water = "#e8f0f4",
|
|
park = "#f0f4f0",
|
|
wood = "#eef2ee",
|
|
scrub_a = "#f5f5f5",
|
|
scrub_b = "#f5f5f5",
|
|
glacier = "#f8f8f8",
|
|
sand = "#f8f6f2",
|
|
beach = "#f8f6f2",
|
|
hospital = "#fafafa",
|
|
school = "#fafafa",
|
|
industrial = "#f5f5f5",
|
|
pedestrian = "#f8f8f8",
|
|
zoo = "#f0f4f0",
|
|
military = "#f5f5f5",
|
|
aerodrome = "#f5f5f5",
|
|
# Faint roads
|
|
highway = "#e0e0e0",
|
|
major = "#e8e8e8",
|
|
medium = "#f0f0f0",
|
|
minor = "#f5f5f5",
|
|
link = "#f5f5f5",
|
|
other = "#f8f8f8",
|
|
railway = "#e8e8e8",
|
|
pier = "#f0f0f0",
|
|
boundary = "#e8e8e8",
|
|
buildings = "#f0f0f0"
|
|
)
|
|
labelRules <- list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "500 11px sans-serif",
|
|
fill = "#666666",
|
|
stroke = "#fafafa",
|
|
width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom <= 6"),
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "italic 10px sans-serif",
|
|
fill = "#888888",
|
|
stroke = "#fafafa",
|
|
width = 1
|
|
), filter = "feature.props.kind === 'region'")
|
|
)
|
|
structure(list(colors = colors, labelRules = labelRules), class = "pm_style")
|
|
},
|
|
|
|
"watercolor" = {
|
|
bg <- "#f4f1ea"
|
|
colors <- pmColors(
|
|
background = bg,
|
|
earth = bg,
|
|
water = "#a8c8d4",
|
|
park = "#d4e6c3",
|
|
wood = "#c8ddb8",
|
|
scrub_a = "#dce8d0",
|
|
scrub_b = "#d0e0c4",
|
|
glacier = "#e8f0f4",
|
|
sand = "#f0e8d8",
|
|
beach = "#f5e6c8",
|
|
hospital = "#f0ebe4",
|
|
school = "#f0ebe4",
|
|
industrial = "#ebe6de",
|
|
pedestrian = "#f0ece4",
|
|
zoo = "#dce8d0",
|
|
military = "#e8e4dc",
|
|
aerodrome = "#ebe6de",
|
|
highway = "#e8e4dc",
|
|
major = "#ebe7df",
|
|
medium = "#f0ece4",
|
|
minor = bg,
|
|
link = bg,
|
|
other = bg,
|
|
railway = "#e0dcd4",
|
|
pier = "#e8e4dc",
|
|
boundary = "#e0dcd4",
|
|
buildings = "#e8e4dc"
|
|
)
|
|
labelRules <- list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "italic 13px Georgia, serif",
|
|
fill = "#5c5c5c",
|
|
stroke = bg,
|
|
width = 2
|
|
), filter = "feature.props.min_zoom <= 6"),
|
|
pmLabelRule("water", pmCenteredTextSymbolizer(
|
|
font = "italic 11px Georgia, serif",
|
|
fill = "#4a7c8c",
|
|
stroke = "#a8c8d4",
|
|
width = 1,
|
|
lineHeight = 1.5
|
|
))
|
|
)
|
|
structure(list(colors = colors, labelRules = labelRules), class = "pm_style")
|
|
},
|
|
|
|
"ink" = {
|
|
bg <- "#ffffff"
|
|
colors <- pmColors(
|
|
background = bg,
|
|
earth = bg,
|
|
water = bg,
|
|
park = bg, wood = bg, scrub_a = bg, scrub_b = bg,
|
|
glacier = bg, sand = bg, beach = bg,
|
|
hospital = bg, school = bg, industrial = bg,
|
|
pedestrian = bg, zoo = bg, military = bg, aerodrome = bg,
|
|
highway = "#000000",
|
|
major = "#000000",
|
|
medium = "#333333",
|
|
minor = "#666666",
|
|
link = "#666666",
|
|
other = "#999999",
|
|
railway = "#000000",
|
|
pier = "#666666",
|
|
boundary = "#cccccc",
|
|
buildings = bg
|
|
)
|
|
labelRules <- list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "500 12px 'Courier New', monospace",
|
|
fill = "#000000",
|
|
stroke = bg,
|
|
width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom <= 6")
|
|
)
|
|
structure(list(colors = colors, labelRules = labelRules), class = "pm_style")
|
|
},
|
|
|
|
"terrain" = {
|
|
bg <- "#f4f0e8"
|
|
colors <- pmColors(
|
|
background = bg,
|
|
earth = bg,
|
|
water = "#a8c8d8",
|
|
park = "#d4e4c8",
|
|
wood = "#c8dcc0",
|
|
scrub_a = "#e0e8d8",
|
|
scrub_b = "#d8e0d0",
|
|
glacier = "#e8f0f4",
|
|
sand = "#f0e8d4",
|
|
beach = "#f4ecd8",
|
|
hospital = "#f0ece8",
|
|
school = "#f0ece8",
|
|
industrial = "#e8e4dc",
|
|
pedestrian = "#f0ece4",
|
|
zoo = "#d8e4d0",
|
|
military = "#e4e0d8",
|
|
aerodrome = "#e8e4dc",
|
|
highway = "#d8d4c8",
|
|
major = "#e0dcd0",
|
|
medium = "#e8e4d8",
|
|
minor = "#f0ece4",
|
|
link = "#f0ece4",
|
|
other = bg,
|
|
railway = "#c8c4b8",
|
|
pier = "#e0dcd0",
|
|
boundary = "#c8c4b8",
|
|
buildings = "#e8e4dc"
|
|
)
|
|
labelRules <- list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "500 12px sans-serif",
|
|
fill = "#5a5040",
|
|
stroke = bg,
|
|
width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom <= 6"),
|
|
pmLabelRule("natural", pmCenteredTextSymbolizer(
|
|
font = "italic 10px sans-serif",
|
|
fill = "#6a6050",
|
|
stroke = bg,
|
|
width = 1
|
|
))
|
|
)
|
|
structure(list(colors = colors, labelRules = labelRules), class = "pm_style")
|
|
},
|
|
|
|
"transit" = {
|
|
bg <- "#fafafa"
|
|
colors <- pmColors(
|
|
background = bg,
|
|
earth = bg,
|
|
water = "#e0e8f0",
|
|
park = "#f0f4f0",
|
|
wood = "#eef2ee",
|
|
scrub_a = "#f5f5f5",
|
|
scrub_b = "#f5f5f5",
|
|
glacier = "#f8f8f8",
|
|
sand = "#f8f6f2",
|
|
beach = "#f8f6f2",
|
|
hospital = bg,
|
|
school = bg,
|
|
industrial = "#f5f5f5",
|
|
pedestrian = "#f8f8f8",
|
|
zoo = "#f0f4f0",
|
|
military = "#f5f5f5",
|
|
aerodrome = "#f0f0f4",
|
|
highway = "#e8e8e8",
|
|
major = "#f0f0f0",
|
|
medium = "#f5f5f5",
|
|
minor = bg,
|
|
link = bg,
|
|
other = bg,
|
|
railway = "#e63946",
|
|
pier = "#f0f0f0",
|
|
boundary = "#e8e8e8",
|
|
buildings = "#f0f0f0"
|
|
)
|
|
labelRules <- list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "500 11px sans-serif",
|
|
fill = "#333333",
|
|
stroke = bg,
|
|
width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom <= 6"),
|
|
pmLabelRule("transit", pmCenteredTextSymbolizer(
|
|
font = "600 10px sans-serif",
|
|
fill = "#e63946",
|
|
stroke = bg,
|
|
width = 2
|
|
))
|
|
)
|
|
structure(list(colors = colors, labelRules = labelRules), class = "pm_style")
|
|
}
|
|
)
|
|
}
|
|
|
|
|
|
#' Create color overrides to hide specific features
|
|
#'
|
|
#' @description
|
|
#' Creates color settings that hide specified feature categories by making
|
|
#' them match the background color.
|
|
#'
|
|
#' @param features Character vector. Features to hide. Options include:
|
|
#' "roads", "buildings", "landuse", "boundaries", "labels".
|
|
#' @param background Character. Background color that hidden features will
|
|
#' match. Default is "#f8f8f8".
|
|
#'
|
|
#' @return A list of color overrides to pass to \code{\link{pmColors}} or
|
|
#' merge with other colors.
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' library(leaflet)
|
|
#' library(protomapr)
|
|
#'
|
|
#' # Hide roads and buildings but keep parks visible
|
|
#' hidden <- pmHideFeatures(c("roads", "buildings"))
|
|
#' leaflet() %>%
|
|
#' setView(lng = -122.4, lat = 37.8, zoom = 12) %>%
|
|
#' addProtomaps(
|
|
#' url = protomaps_url(),
|
|
#' colors = modifyList(pmColors(water = "#1a3a5c"), hidden)
|
|
#' )
|
|
#' }
|
|
#'
|
|
#' @export
|
|
pmHideFeatures <- function(features, background = "#f8f8f8") {
|
|
colors <- list()
|
|
|
|
if ("roads" %in% features) {
|
|
colors <- c(colors, list(
|
|
highway = background, major = background, medium = background,
|
|
minor = background, link = background, other = background,
|
|
railway = background, pier = background
|
|
))
|
|
}
|
|
|
|
if ("buildings" %in% features) {
|
|
colors <- c(colors, list(buildings = background))
|
|
}
|
|
|
|
if ("landuse" %in% features) {
|
|
colors <- c(colors, list(
|
|
park_a = background, park_b = background,
|
|
wood_a = background, wood_b = background,
|
|
scrub_a = background, scrub_b = background,
|
|
glacier = background, sand = background, beach = background,
|
|
hospital = background, school = background, industrial = background,
|
|
pedestrian = background, zoo = background, military = background,
|
|
aerodrome = background
|
|
))
|
|
}
|
|
|
|
if ("boundaries" %in% features) {
|
|
colors <- c(colors, list(boundary = background))
|
|
}
|
|
|
|
colors
|
|
}
|
|
|
|
|
|
#' Create preset label rules for city names
|
|
#'
|
|
#' @description
|
|
#' Creates label rules for displaying city/place names with common styling
|
|
#' patterns.
|
|
#'
|
|
#' @param style Character. Label style preset:
|
|
#' \describe{
|
|
#' \item{"hierarchical"}{Size varies by city importance (min_zoom)}
|
|
#' \item{"major-only"}{Only major cities (min_zoom <= 5)}
|
|
#' \item{"all"}{All cities with uniform styling}
|
|
#' }
|
|
#' @param color Character. Text color. Default is "#333333".
|
|
#' @param halo Character. Halo/stroke color. Default is "white".
|
|
#' @param include_regions Logical. Include state/region labels. Default is TRUE.
|
|
#'
|
|
#' @return A list of label rules to pass to \code{\link{addProtomaps}}.
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' library(leaflet)
|
|
#' library(protomapr)
|
|
#'
|
|
#' leaflet() %>%
|
|
#' setView(lng = -122.4, lat = 37.8, zoom = 8) %>%
|
|
#' addProtomaps(
|
|
#' url = protomaps_url(),
|
|
#' colors = pmColors(earth = "#f0f0f0", water = "#1a3a5c"),
|
|
#' labelRules = pmCityLabels("hierarchical")
|
|
#' )
|
|
#' }
|
|
#'
|
|
#' @export
|
|
pmCityLabels <- function(style = c("hierarchical", "major-only", "all"),
|
|
color = "#333333",
|
|
halo = "white",
|
|
include_regions = TRUE) {
|
|
style <- match.arg(style)
|
|
|
|
rules <- switch(style,
|
|
"hierarchical" = list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "600 16px sans-serif", fill = color, stroke = halo, width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom <= 4"),
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "600 13px sans-serif", fill = color, stroke = halo, width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom > 4 && feature.props.min_zoom <= 6"),
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "500 11px sans-serif", fill = color, stroke = halo, width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom > 6 && feature.props.min_zoom <= 8"),
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "400 9px sans-serif", fill = color, stroke = halo, width = 1
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom > 8")
|
|
),
|
|
|
|
"major-only" = list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "600 14px sans-serif", fill = color, stroke = halo, width = 2
|
|
), filter = "feature.props.kind === 'locality' && feature.props.min_zoom <= 5")
|
|
),
|
|
|
|
"all" = list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "500 11px sans-serif", fill = color, stroke = halo, width = 2
|
|
), filter = "feature.props.kind === 'locality'")
|
|
)
|
|
)
|
|
|
|
if (include_regions) {
|
|
rules <- c(rules, list(
|
|
pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
font = "italic 12px sans-serif",
|
|
fill = "#888888",
|
|
stroke = halo,
|
|
width = 1
|
|
), filter = "feature.props.kind === 'region'")
|
|
))
|
|
}
|
|
|
|
rules
|
|
}
|
|
|
|
|
|
#' Print method for pm_style objects
|
|
#'
|
|
#' @description
|
|
#' Prints a formatted summary of a pm_style object showing colors and label rules.
|
|
#'
|
|
#' @param x A pm_style object.
|
|
#' @param ... Additional arguments (ignored).
|
|
#'
|
|
#' @return Invisibly returns x.
|
|
#'
|
|
#' @export
|
|
print.pm_style <- function(x, ...) {
|
|
cat("<pm_style>\n")
|
|
|
|
if (!is.null(x$colors) && length(x$colors) > 0) {
|
|
cat("\nColors:\n")
|
|
|
|
base_names <- c("background", "earth", "water")
|
|
road_names <- c("highway", "major", "medium", "minor", "link", "other", "railway", "pier")
|
|
landuse_names <- c("park", "park_a", "park_b", "wood", "wood_a", "wood_b",
|
|
"scrub_a", "scrub_b", "glacier", "sand", "beach",
|
|
"hospital", "school", "industrial", "pedestrian",
|
|
"zoo", "military", "aerodrome")
|
|
|
|
# Base colors
|
|
base <- x$colors[names(x$colors) %in% base_names]
|
|
if (length(base) > 0) {
|
|
cat(" Base:\n")
|
|
for (nm in intersect(base_names, names(base))) {
|
|
cat(sprintf(" %s: %s\n", nm, base[[nm]]))
|
|
}
|
|
}
|
|
|
|
# Roads - summarize if uniform
|
|
roads <- x$colors[names(x$colors) %in% road_names]
|
|
if (length(roads) > 0) {
|
|
unique_colors <- unique(unlist(roads))
|
|
if (length(unique_colors) == 1) {
|
|
cat(sprintf(" Roads: %s (uniform)\n", unique_colors))
|
|
} else {
|
|
cat(" Roads:\n")
|
|
for (nm in intersect(road_names, names(roads))) {
|
|
cat(sprintf(" %s: %s\n", nm, roads[[nm]]))
|
|
}
|
|
}
|
|
}
|
|
|
|
# Land use - summarize if uniform
|
|
landuse <- x$colors[names(x$colors) %in% landuse_names]
|
|
if (length(landuse) > 0) {
|
|
unique_colors <- unique(unlist(landuse))
|
|
if (length(unique_colors) == 1) {
|
|
cat(sprintf(" Land use: %s (uniform)\n", unique_colors))
|
|
} else {
|
|
n_landuse <- length(landuse)
|
|
cat(sprintf(" Land use: %d custom colors\n", n_landuse))
|
|
}
|
|
}
|
|
|
|
# Other colors
|
|
other_names <- setdiff(names(x$colors), c(base_names, road_names, landuse_names))
|
|
if (length(other_names) > 0) {
|
|
cat(sprintf(" Other: %d additional colors\n", length(other_names)))
|
|
}
|
|
}
|
|
|
|
if (!is.null(x$labelRules) && length(x$labelRules) > 0) {
|
|
cat(sprintf("\nLabel Rules: %d\n", length(x$labelRules)))
|
|
for (i in seq_along(x$labelRules)) {
|
|
rule <- x$labelRules[[i]]
|
|
cat(sprintf(" [%d] %s", i, rule$dataLayer))
|
|
if (!is.null(rule$filter)) {
|
|
filter_display <- if (nchar(rule$filter) > 40) {
|
|
paste0(substr(rule$filter, 1, 37), "...")
|
|
} else {
|
|
rule$filter
|
|
}
|
|
cat(sprintf(" | %s", filter_display))
|
|
}
|
|
cat("\n")
|
|
}
|
|
} else {
|
|
cat("\nLabel Rules: none\n")
|
|
}
|
|
|
|
invisible(x)
|
|
}
|
|
|
|
|
|
#' Modify an Existing Style
|
|
#'
|
|
#' @description
|
|
#' Creates a new pm_style by modifying an existing one. Useful for tweaking
|
|
#' preset styles without rebuilding from scratch.
|
|
#'
|
|
#' @param style A pm_style object to modify.
|
|
#' @param colors Named list of color overrides (from pmColors() or manual list).
|
|
#' @param labelRules Optional list of label rules to replace or add.
|
|
#' @param replace_labels Logical. If TRUE, replaces all label rules. If FALSE,
|
|
#' appends new rules. Default is FALSE.
|
|
#' @param ... Additional color overrides as named arguments.
|
|
#'
|
|
#' @return A new pm_style object with modifications applied.
|
|
#'
|
|
#' @examples
|
|
#' \dontrun{
|
|
#' # Start with watercolor, change water color
|
|
#' my_style <- pmModifyStyle(pmStyle("watercolor"), water = "#1a3a5c")
|
|
#'
|
|
#' # Add label rules to minimal style
|
|
#' my_style <- pmModifyStyle(
|
|
#' pmMinimal(),
|
|
#' labelRules = pmCityLabels("major-only")
|
|
#' )
|
|
#'
|
|
#' # Multiple modifications
|
|
#' my_style <- pmModifyStyle(
|
|
#' pmStyle("muted"),
|
|
#' colors = pmColors(water = "#2a4a6c", park = "#c0d8c0"),
|
|
#' replace_labels = TRUE,
|
|
#' labelRules = list(
|
|
#' pmLabelRule("places", pmCenteredTextSymbolizer(
|
|
#' font = "bold 14px Arial",
|
|
#' fill = "#333"
|
|
#' ))
|
|
#' )
|
|
#' )
|
|
#' }
|
|
#'
|
|
#' @seealso \code{\link{pmStyle}}, \code{\link{pmMinimal}}
|
|
#' @export
|
|
pmModifyStyle <- function(style,
|
|
colors = NULL,
|
|
labelRules = NULL,
|
|
replace_labels = FALSE,
|
|
...) {
|
|
if (!inherits(style, "pm_style")) {
|
|
stop("'style' must be a pm_style object", call. = FALSE)
|
|
}
|
|
|
|
new_style <- style
|
|
|
|
extra_colors <- list(...)
|
|
if (!is.null(colors) || length(extra_colors) > 0) {
|
|
all_overrides <- c(colors, extra_colors)
|
|
new_style$colors <- utils::modifyList(
|
|
new_style$colors %||% list(),
|
|
all_overrides
|
|
)
|
|
}
|
|
|
|
if (!is.null(labelRules)) {
|
|
if (replace_labels) {
|
|
new_style$labelRules <- labelRules
|
|
} else {
|
|
new_style$labelRules <- c(new_style$labelRules, labelRules)
|
|
}
|
|
}
|
|
|
|
structure(new_style, class = "pm_style")
|
|
}
|