protomapr/R/addProtomaps.R

# Package-level constants for base flavor colors
.baseFlavors <- list(

  light = list(
    background = "#cccccc", earth = "#e0e0e0", park_a = "#cfddd5", park_b = "#9cd3b4",
    hospital = "#e4dad9", industrial = "#d1dde1", school = "#e4ded7",
    wood_a = "#d0ded0", wood_b = "#a0d9a0", pedestrian = "#e3e0d4",
    scrub_a = "#cedcd7", scrub_b = "#99d2bb", glacier = "#e7e7e7",
    sand = "#e2e0d7", beach = "#e8e4d0", aerodrome = "#dadbdf",
    runway = "#e9e9ed", water = "#80deea", pier = "#e0e0e0",
    zoo = "#c6dcdc", military = "#dcdcdc", ferry = "#5f9ea0",
    boundary = "#aaaaaa", other = "#ebebeb", minor = "#ffffff",
    link = "#ffffff", medium = "#f0eded", major = "#f5f5f5",
    highway = "#ffffff", railway = "#a7b1b3",
    ocean_label = "#5f9ea0", city_label = "#444444",
    state_label = "#888888", country_label = "#666666"
  ),
  dark = list(
    background = "#2d2d2d", earth = "#3d3d3d", park_a = "#3a4a40", park_b = "#4a5a50",
    hospital = "#4a4040", industrial = "#3a4044", school = "#4a4540",
    wood_a = "#3a4a3a", wood_b = "#4a5a4a", pedestrian = "#3a3a35",
    scrub_a = "#3a4540", scrub_b = "#4a5550", glacier = "#4a4a4a",
    sand = "#4a4840", beach = "#4a4840", aerodrome = "#3a3a40",
    runway = "#4a4a50", water = "#28404a", pier = "#3d3d3d",
    zoo = "#3a4545", military = "#3a3a3a", ferry = "#3a5a6a",
    boundary = "#555555", other = "#4a4a4a", minor = "#4a4a4a",
    link = "#4a4a4a", medium = "#5a5a5a", major = "#5a5a5a",
    highway = "#6a6a6a", railway = "#555555",
    ocean_label = "#5a8a9a", city_label = "#cccccc",
    state_label = "#888888", country_label = "#aaaaaa"
  )
)

#' Add a Protomaps layer to a Leaflet map
#'
#' @description
#' Adds a vector tile layer from a PMTiles source to a Leaflet map using
#' the protomaps-leaflet library. Supports built-in flavors and custom
#' styling rules.
#'
#' @param map A leaflet map object created with \code{\link[leaflet]{leaflet}}.
#' @param url Character. URL to a PMTiles file or a tile endpoint with
#'   \code{{z}/{x}/{y}.mvt} placeholders.
#' @param style Optional style object created with \code{\link{pmMinimal}} or
#'   \code{\link{pmStyle}}. Provides a convenient way to apply preset styles.
#'   If provided, overrides \code{colors} and \code{labelRules}.
#' @param flavor Character. Built-in flavor/theme to use. One of "light", "dark",
#'   "white", "grayscale", or "black". Default is "light". Ignored if \code{style}
#'   is provided.
#' @param colors Optional list of color overrides. Use \code{\link{pmColors}} to
#'   create this. Overrides specific colors while keeping built-in rendering rules.
#' @param paintRules Optional list of paint rules created with \code{\link{pmPaintRule}}.
#'   If provided, completely overrides the flavor's default paint rules.
#'   For simple color changes, use \code{colors} instead.
#' @param labelRules Optional list of label rules created with \code{\link{pmLabelRule}}.
#'   If provided, completely overrides the flavor's default label rules.
#' @param backgroundColor Character. Background color for the canvas.
#'   Default is NULL (uses flavor default).
#' @param lang Character. Language code for labels (e.g., "en", "de", "zh").
#'   Default is NULL (uses default language).
#' @param attribution Character. Attribution text for the layer.
#'   Default is "Protomaps".
#' @param options A list of additional options created with \code{\link{protomapsOptions}}.
#' @param layerId Character. Layer ID for the protomaps layer.
#' @param group Character. Group name for layer control.
#'
#' @return A modified leaflet map object.
#'
#' @examples
#' \dontrun{
#' library(leaflet)
#' library(protomapr)
#'
#' # Basic usage with demo tiles
#' leaflet() %>%
#'   setView(lng = -122.4, lat = 37.8, zoom = 12) %>%
#'   addProtomaps(url = protomaps_demo_url())
#'
#' # Using dark flavor
#' leaflet() %>%
#'   setView(lng = -122.4, lat = 37.8, zoom = 12) %>%
#'   addProtomaps(url = protomaps_demo_url(), flavor = "dark")
#'
#' # Custom colors with proper rendering
#' leaflet() %>%
#'   setView(lng = -122.4, lat = 37.8, zoom = 12) %>%
#'   addProtomaps(
#'     url = protomaps_demo_url(),
#'     colors = pmColors(earth = "#d3d3d3", water = "#1a3a5c")
#'   )
#'
#' # Using preset styles (recommended for common use cases)
#' leaflet() %>%
#'   setView(lng = -122.4, lat = 37.8, zoom = 10) %>%
#'   addProtomaps(url = protomaps_demo_url(), style = pmStyle("minimal"))
#'
#' # Custom minimal style
#' leaflet() %>%
#'   setView(lng = -122.4, lat = 37.8, zoom = 10) %>%
#'   addProtomaps(
#'     url = protomaps_demo_url(),
#'     style = pmMinimal(land = "#f5f5f0", water = "#1a3a5c", labels = TRUE)
#'   )
#' }
#'
#' @export
#' @import leaflet
#' @importFrom htmlwidgets onRender
#' @importFrom jsonlite toJSON
addProtomaps <- function(map,
                          url,
                          style = NULL,
                          flavor = c("light", "dark", "white", "grayscale", "black"),
                          colors = NULL,
                          paintRules = NULL,
                          labelRules = NULL,
                          backgroundColor = NULL,
                          lang = NULL,
                          attribution = "Protomaps",
                          options = protomapsOptions(),
                          layerId = NULL,
                          group = NULL) {

  flavor <- match.arg(flavor)


  # Handle style parameter
  if (!is.null(style)) {
    if (inherits(style, "pm_style")) {
      colors <- style$colors
      labelRules <- style$labelRules
    } else if (is.list(style)) {
      if (!is.null(style$colors)) colors <- style$colors
      if (!is.null(style$labelRules)) labelRules <- style$labelRules
    }
  }

  # Build the options object for JavaScript
  jsOptions <- list(
    url = url,
    flavor = flavor,
    attribution = attribution
  )

  if (!is.null(colors)) {
    jsOptions$customColors <- colors
    jsOptions$baseFlavor <- .baseFlavors[[flavor]] %||% .baseFlavors$light
  }

  if (!is.null(backgroundColor)) {
    jsOptions$backgroundColor <- backgroundColor
  }

  if (!is.null(lang)) {
    jsOptions$lang <- lang
  }

  if (!is.null(paintRules)) {
    jsOptions$paintRules <- paintRules
  }

  if (!is.null(labelRules)) {
    jsOptions$labelRules <- labelRules
  }

  # Merge additional options
  jsOptions <- c(jsOptions, options)

  if (!is.null(layerId)) {
    jsOptions$layerId <- layerId
  }

  if (!is.null(group)) {
    jsOptions$group <- group
  }

  # Convert to JSON
  jsOptionsJson <- jsonlite::toJSON(jsOptions, auto_unbox = TRUE, null = "null")

  # Add the protomaps dependency to the widget
  map$dependencies <- c(map$dependencies, list(protomapsDependency()))

  # JavaScript code to add the layer
  jsCode <- sprintf("
    function(el, x) {
      var map = this;
      var options = %s;

      // Helper to create symbolizer from config
      var symTypes = {
        polygon: protomapsL.PolygonSymbolizer,
        line: protomapsL.LineSymbolizer,
        circle: protomapsL.CircleSymbolizer,
        text: protomapsL.TextSymbolizer,
        centeredText: protomapsL.CenteredTextSymbolizer,
        lineLabel: protomapsL.LineLabelSymbolizer,
        shield: protomapsL.ShieldSymbolizer
      };

      function createSymbolizer(sym, defaultType) {
        var Ctor = symTypes[sym.type] || symTypes[defaultType];
        return new Ctor(sym.options || {});
      }

      function processRule(rule, defaultSymType) {
        var result = {
          dataLayer: rule.dataLayer,
          symbolizer: createSymbolizer(rule.symbolizer, defaultSymType)
        };
        if (rule.minzoom !== null) result.minzoom = rule.minzoom;
        if (rule.maxzoom !== null) result.maxzoom = rule.maxzoom;
        if (rule.filter) {
          try {
            result.filter = new Function('zoom', 'feature', 'return ' + rule.filter);
          } catch(e) {
            console.error('Invalid filter:', rule.filter, e);
          }
        }
        return result;
      }

      // Build layer options
      var layerOptions = {
        url: options.url,
        attribution: options.attribution
      };

      // Handle custom colors - merge with base flavor
      if (options.customColors && options.baseFlavor && !options.paintRules) {
        var customFlavor = Object.assign({}, options.baseFlavor, options.customColors);
        layerOptions.paintRules = protomapsL.paintRules(customFlavor);
        layerOptions.labelRules = [];
        if (customFlavor.background) {
          layerOptions.backgroundColor = customFlavor.background;
        }
      }
      else if (options.flavor && !options.paintRules && !options.customColors) {
        layerOptions.flavor = options.flavor;
      }

      if (options.lang) layerOptions.lang = options.lang;

      if (options.paintRules) {
        layerOptions.paintRules = options.paintRules.map(function(r) {
          return processRule(r, 'polygon');
        });
      }

      if (options.labelRules) {
        layerOptions.labelRules = options.labelRules.map(function(r) {
          return processRule(r, 'centeredText');
        });
      }

      if (options.backgroundColor) {
        layerOptions.backgroundColor = options.backgroundColor;
      }

      if (options.maxDataZoom) {
        layerOptions.maxDataZoom = options.maxDataZoom;
      }

      if (options.tileSize) {
        layerOptions.tileSize = options.tileSize;
      }

      // Create and add the layer
      var protoLayer = protomapsL.leafletLayer(layerOptions);
      protoLayer.addTo(map);

      // Store reference for potential later use
      if (options.layerId) {
        if (!map._protomapsLayers) map._protomapsLayers = {};
        map._protomapsLayers[options.layerId] = protoLayer;
      }
    }
  ", jsOptionsJson)

  htmlwidgets::onRender(map, jsCode)
}


#' Protomaps layer options
#'
#' @description
#' Create additional options for protomaps layer configuration.
#'
#' @param maxDataZoom Numeric. Maximum zoom level to fetch tile data.
#'   Tiles beyond this zoom will be overzoomed.
#' @param tileSize Numeric. Size of tiles in pixels. Default is 256.
#' @param debug Logical. Enable debug mode to visualize tile boundaries.
#' @param ... Additional options passed to the layer.
#'
#' @return A list of options.
#'
#' @examples
#' protomapsOptions(maxDataZoom = 14, tileSize = 512)
#'
#' @export
protomapsOptions <- function(maxDataZoom = NULL,
                              tileSize = NULL,
                              debug = FALSE,
                              ...) {
  opts <- list(...)

  if (!is.null(maxDataZoom)) opts$maxDataZoom <- maxDataZoom
  if (!is.null(tileSize)) opts$tileSize <- tileSize
  if (debug) opts$debug <- TRUE

  opts
}


#' Create Protomaps HTML dependency
#'
#' @description
#' Creates the HTML dependency for the protomaps-leaflet JavaScript library.
#' This is automatically included when using \code{\link{addProtomaps}}.
#'
#' @param version Character. Version of protomaps-leaflet to use.
#'   Default is "5.1.0".
#'
#' @return An htmltools::htmlDependency object.
#'
#' @examples
#' protomapsDependency()
#'
#' @export
#' @importFrom htmltools htmlDependency
protomapsDependency <- function(version = "5.1.0") {
  htmltools::htmlDependency(
    name = "protomaps-leaflet",
    version = version,
    src = system.file(
      sprintf("htmlwidgets/lib/protomaps-leaflet-%s", version),
      package = "protomapr"
    ),
    script = "protomaps-leaflet.js"
  )
}


#' Get Protomaps API tile URL
#'
#' @description
#' Returns a URL template for the Protomaps tile API. Requires an API key,
#' which can be passed directly or set via the \code{PROTOMAPS_API_KEY}
#' environment variable.
#'
#' Get a free API key (for non-commercial use) at \url{https://protomaps.com/}.
#' For commercial use or high traffic, consider self-hosting PMTiles files.
#'
#' @param api_key Character. Your Protomaps API key. If NULL (default),
#'   uses the \code{PROTOMAPS_API_KEY} environment variable.
#'
#' @return Character. URL template for the tile API.
#'
#' @examples
#' \dontrun{
#' # Set your API key as an environment variable (recommended)
#' Sys.setenv(PROTOMAPS_API_KEY = "your-api-key-here")
#' leaflet() %>%
#'   addProtomaps(url = protomaps_url())
#'
#' # Or pass the key directly
#' leaflet() %>%
#'   addProtomaps(url = protomaps_url(api_key = "your-api-key-here"))
#' }
#'
#' @seealso \code{\link{set_protomaps_key}} for a convenient way to set the API key.
#'
#' @export
protomaps_url <- function(api_key = NULL) {
  if (is.null(api_key)) {
    api_key <- Sys.getenv("PROTOMAPS_API_KEY", unset = "")
  }

  if (api_key == "") {
    stop(
      "Protomaps API key required.\n",
      "Get a free key at: https://protomaps.com/\n",
      "Then either:\
",
      "
 - Set PROTOMAPS_API_KEY environment variable: Sys.setenv(PROTOMAPS_API_KEY = 'your-key')\n",
      "
 - Or pass directly: protomaps_url(api_key = 'your-key')\n",
      "
 - Or self-host PMTiles: see vignette('getting-started')",
      call. = FALSE
    )
  }

  sprintf("https://api.protomaps.com/tiles/v4/{z}/{x}/{y}.mvt?key=%s", api_key)
}


#' Set Protomaps API key
#'
#' @description
#' Convenience function to set your Protomaps API key for the current session.
#' The key is stored in the \code{PROTOMAPS_API_KEY} environment variable.
#'
#' For persistent storage, add to your \code{.Renviron} file:
#' \code{PROTOMAPS_API_KEY=your-key-here}
#'
#' Get a free API key at \url{https://protomaps.com/}.
#'
#' @param api_key Character. Your Protomaps API key.
#'
#' @return Invisibly returns the API key.
#'
#' @examples
#' \dontrun{
#' set_protomaps_key("your-api-key-here")
#'
#' # Now protomaps_url() will work without arguments
#' leaflet() %>%
#'   addProtomaps(url = protomaps_url())
#' }
#'
#' @export
set_protomaps_key <- function(api_key) {
  Sys.setenv(PROTOMAPS_API_KEY = api_key)
  message("Protomaps API key set for this session.")
  invisible(api_key)
}


#' @rdname protomaps_url
#' @export
protomaps_demo_url <- function(api_key = NULL) {
  .Deprecated("protomaps_url")
  protomaps_url(api_key = api_key)
}