#' Add a Legend with Images
#'
#' Creates a legend with images that are embedded into a 'leaflet' map so that
#' images do not need to be packaged when saving a 'leaflet' map as HTML. Full
#' control over the label and title style. The 'leaflet' map is passed through
#' and the output is a control so that legend is fully integrated with other
#' functionalities.
#'
#' @param map
#'
#' a map widget object created from 'leaflet'
#'
#' @param images
#'
#' path to the image file
#'
#' @param labels
#'
#' labels for each image
#'
#' @param title
#'
#' the legend title, pass in HTML to style
#'
#' @param labelStyle
#'
#' character string of style argument for HTML text
#'
#' @param orientation
#'
#' stack the legend items vertically or horizontally
#'
#' @param width
#'
#' in pixels
#'
#' @param height
#'
#' in pixels
#'
#' @param group
#'
#' group name of a leaflet layer group
#'
#' @param className
#'
#' extra CSS class to append to the control, space separated
#'
#' @param ...
#'
#' arguments to pass to \link[leaflet]{addControl}
#'
#' @return
#'
#' an object from \link[leaflet]{addControl}
#'
#' @export
#'
#' @examples
#'
#' library(leaflet)
#' data(quakes)
#'
#' quakes1 <- quakes[1:10,]
#'
#' colors <- c('blue', 'red', 'yellow', 'green', 'orange', 'purple')
#' i <- as.integer(cut(quakes$mag, breaks = quantile(quakes$mag, seq(0,1,1/6)),
#'                     include.lowest = TRUE))
#' leafImg <- system.file(sprintf('img/leaf-%s.png', colors),
#'                        package = 'leaflegend')
#' leafIcons <- icons(
#'   iconUrl = leafImg[i],
#'   iconWidth = 133/236 * 50, iconHeight = 50
#' )
#' leaflet(data = quakes) %>% addTiles() %>%
#'   addMarkers(~long, ~lat, icon = leafIcons) %>%
#'   addLegendImage(images = leafImg,
#'                  labels = colors,
#'                  width = 133/236 * 50,
#'                  height = 50,
#'                  orientation = 'vertical',
#'                  title = htmltools::tags$div('Leaf',
#'                                              style = 'font-size: 24px;
#'                                              text-align: center;'),
#'                  position = 'topright')
#'
#'  # use raster images with size encodings
#'  height <- sizeNumeric(quakes$depth, baseSize = 40)
#'  width <- height * 38 / 95
#'  symbols <- icons(
#'    iconUrl = leafImg[4],
#'    iconWidth = width,
#'    iconHeight = height)
#'  probs <- c(.2, .4, .6, .8)
#'  leaflet(quakes) %>%
#'    addTiles() %>%
#'    addMarkers(icon = symbols,
#'               lat = ~lat, lng = ~long) %>%
#'    addLegendImage(
#'      images = rep(leafImg[4], 4),
#'      labels = round(quantile(height, probs = probs), 0),
#'      width = quantile(height, probs = probs) * 38 / 95,
#'      height = quantile(height, probs = probs),
#'      title = htmltools::tags$div(
#'        'Leaf',
#'        style = 'font-size: 24px; text-align: center; margin-bottom: 5px;'),
#'      position = 'topright', orientation = 'vertical')
addLegendImage <- function(
    map,
    images,
    labels,
    title = NULL,
    labelStyle = 'font-size: 24px; vertical-align: middle;',
    orientation = c('vertical', 'horizontal'),
    width = 20,
    height = 20,
    group = NULL,
    className = 'info legend leaflet-control',
    ...) {
  stopifnot(length(images) == length(labels))
  stopifnot( all(width >= 0) && all(height >= 0) )
  orientation <- match.arg(orientation)
  if ( orientation == 'vertical' ) {
    htmlTag <- htmltools::tags$div
  } else {
    htmlTag <- htmltools::tags$span
  }
  if ( inherits(images, 'svgURI') ) {
    images <- list(images)
  }
  htmlElements <- Map(
    img = images,
    label = labels,
    htmlTag = list(htmlTag),
    width = width,
    height = height,
    maxWidth = max(width) * (orientation == 'vertical'),
    f =
      function(img, label, htmlTag, height, width, maxWidth) {
        marginWidth <- max(0, (maxWidth - width) / 2)
        imgStyle <- sprintf(
      'vertical-align: %s; margin: %spx; margin-right: %spx; margin-left: %spx',
      'middle', 5, marginWidth, marginWidth)
        if ( inherits(img, 'svgURI') ) {
          imgTag <- htmltools::tags$img(
            src = img,
            style = imgStyle,
            height = height,
            width = width
          )
        } else {
          fileExt <- tolower(sub('.+(\\.)([a-zA-Z]+)', '\\2', img))
          stopifnot(fileExt %in% c('png', 'jpg', 'jpeg'))
          imgTag <- htmltools::tags$img(
            src = sprintf(
              'data:image/%s;base64,%s',
              fileExt,
              base64enc::base64encode(img)
            ),
            style = imgStyle,
            height = height,
            width = width
          )
        }
        htmlTag(imgTag, htmltools::tags$span(label, style = labelStyle))
      }
  )
  htmlElements <- addTitle(title = title, htmlElements = htmlElements)
  leaflegendAddControl(map, html = htmltools::tagList(htmlElements),
                       className = className, group = group, ...)
}

#' Create Map Symbols for 'leaflet' maps
#'
#'
#'
#'
#' @param shape
#'
#' the desired shape of the symbol, See \link[leaflegend]{availableShapes}
#'
#' @param width
#'
#' in pixels
#'
#' @param height
#'
#' in pixels
#'
#' @param color
#'
#' color of the symbol
#'
#' @param fillColor
#'
#' fill color of symbol
#'
#' @param opacity
#'
#' opacity of color
#'
#' @param fillOpacity
#'
#' opacity of fillColor
#'
#' @param strokeWidth
#'
#' width in pixels of symbol outline
#'
#' @param label
#'
#' character string to display at the center of the symbol
#'
#' @param ...
#'
#' arguments to be passed to svg shape tag
#'
#' @return
#'
#' HTML svg element
#'
#' @examples
#' library(leaflet)
#' data(quakes)
#'
#' # symbol with a label centered inside
#' makeSymbol('circle', width = 24, color = 'black', fillColor = 'steelblue',
#'            fillOpacity = 0.8, label = 'A')
#'
#' # map markers with per-point labels
#' quakes$label <- as.character(seq_len(nrow(quakes)))
#' leaflet(quakes[1:20, ]) %>%
#'   addTiles() %>%
#'   addSymbols(lat = ~lat, lng = ~long, color = 'black',
#'              fillColor = 'steelblue', fillOpacity = 0.8,
#'              label = ~label)
#'
#' @name mapSymbols
#'
#' @export
#'
makeSymbol <- function(shape, width, height = width, color, fillColor = color,
                       opacity = 1, fillOpacity = opacity, label = NULL, ...) {
  svg <- makeSymbolElement(shape = shape, width, height = height,
    color = color, fillColor = fillColor, opacity = opacity,
    fillOpacity = fillOpacity, label = label, ...)
  strokeWidth <- 1
  if ( 'stroke-width' %in% names(list(...)) ) {
    strokeWidth <- list(...)[['stroke-width']]
  }
  makeSvgUri(svg = svg, width = width, height = height,
    strokeWidth = strokeWidth)
}
makeSymbolElement <- function(shape, width, height = width, color,
  fillColor = color, opacity = 1, fillOpacity = opacity, label = NULL, ...) {
  stopifnot(is.numeric(width) & is.numeric(height))
  stopifnot(is.numeric(opacity) & is.numeric(fillOpacity))
  stopifnot(!is.na(shape))
  if (shape %in% availableShapes()[['default']]) {
    svg <- symbolSvg(shape = shape,  width = width, height = height,
      color = color, fillColor = fillColor, opacity = opacity,
      fillOpacity = fillOpacity, ...)
  } else if (shape %in% availableShapes()[['pch']] || shape %in%
      (seq_along(availableShapes()[['pch']]) - 1)) {
    svg <- pchSvg(shape = shape,  width = width, height = height,
      color = color, fillColor = fillColor, opacity = opacity,
      fillOpacity = fillOpacity, ...)
  } else if (shape %in% availableShapes()[['special']]) {
    svg <- specialSvg(shape = shape,  width = width, height = height,
      color = color, fillColor = fillColor, opacity = opacity,
      fillOpacity = fillOpacity, ...)
  } else {
    stop('Argument "shape" is invalid. See `availableShapes()`.')
  }
  if ( !is.null(label) ) {
    labelElement <- htmltools::tags$text(
      x = '50%',
      y = '50%',
      'dominant-baseline' = 'central',
      'text-anchor' = 'middle',
      'font-size' = paste0(round(min(width, height) * 0.6), 'px'),
      'font-family' = 'sans-serif',
      fill = color,
      'stroke-width' = 0,
      label
    )
    svg <- htmltools::tagList(svg, labelElement)
  }
  svg
}
symbolSvg <- function(shape, width, height, color, fillColor, opacity,
  fillOpacity, ...) {
  strokeWidth <- 1
  if ( 'stroke-width' %in% names(list(...)) ) {
    strokeWidth <- list(...)[['stroke-width']]
  }
  switch(
    shape,
    'rect' = htmltools::tags$rect(
      id = 'rect',
      x = strokeWidth,
      y = strokeWidth,
      height = height,
      width = width,
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'circle' = htmltools::tags$circle(
      id = 'circle',
      cx = height / 2 + strokeWidth,
      cy = height / 2 + strokeWidth,
      r = height / 2,
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'triangle' = htmltools::tags$polygon(
      id = 'triangle',
      points = sprintf('%s,%s %s,%s %s,%s',
        strokeWidth,
        height + strokeWidth,
        width + strokeWidth,
        height + strokeWidth,
        width / 2  + strokeWidth,
        strokeWidth),
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'plus' = htmltools::tags$polygon(
      id = 'plus',
      points = drawPlus(width = width, height = height, offset = strokeWidth),
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'cross' = htmltools::tags$polygon(
      id = 'cross',
      points = drawCross(width = width, height = height, offset = strokeWidth),
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'diamond' = htmltools::tags$polygon(
      id = 'diamond',
      points = drawDiamond(width = width, height = height,
        offset = strokeWidth),
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'star' = htmltools::tags$polygon(
      id = 'star',
      points = drawStar(width = width, height = height, offset = strokeWidth),
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'stadium' = htmltools::tags$rect(
      id = 'stadium',
      x = strokeWidth,
      y = strokeWidth,
      height = height,
      width = width,
      rx = "25%",
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'line' = htmltools::tags$line(
      id = 'line',
      x1 = 0,
      x2 = width + strokeWidth * 2,
      y1 = height / 2 + strokeWidth,
      y2 = height / 2 + strokeWidth,
      stroke = color,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    'polygon' = htmltools::tags$polygon(
      id = 'polygon',
      points = drawPolygon(n = 5, width = width, height = height,
        offset = strokeWidth),
      stroke = color,
      fill = fillColor,
      'stroke-opacity' = opacity,
      'fill-opacity' = fillOpacity,
      ...
    ),
    stop('Invalid shape argument.')
  )
}
pchSvg <- function(shape, width, height, color, fillColor, opacity,
  fillOpacity, ...) {
  hexPercentOffset <- .8
  strokeWidth <- 1
  if ( 'stroke-width' %in% names(list(...)) ) {
    strokeWidth <- list(...)[['stroke-width']]
  }
  pchShape <-
    list(
      'open-rect' = htmltools::tags$g(
        transform = sprintf('translate(%f %f)', strokeWidth, strokeWidth),
        htmltools::tags$rect(
          id = 'open-rect',
          x = 0,
          y = 0,
          height = height,
          width = width,
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'open-circle' = htmltools::tags$g(
        transform = sprintf('translate(%f %f)', strokeWidth, strokeWidth),
        htmltools::tags$circle(
          id = 'circle',
          cx = height / 2,
          cy = height / 2,
          r = height / 2,
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'open-triangle' = htmltools::tags$g(
        transform = sprintf('translate(%f %f)', strokeWidth, strokeWidth),
        htmltools::tags$polygon(
          id = 'triangle',
          points = drawTriangle(width = width, height = height,
            offset = 0),
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'simple-plus' = htmltools::tags$g(
        transform = sprintf('translate(%f %f)', strokeWidth, strokeWidth),
        htmltools::tags$line(
          id = 'pline1',
          x1 = 0,
          x2 = width,
          y1 = height / 2,
          y2 = height / 2,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'pline2',
          x1 = width / 2,
          x2 = width / 2,
          y1 = 0,
          y2 = height,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'simple-cross' = htmltools::tags$g(
        transform = sprintf('translate(%f %f)', strokeWidth, strokeWidth),
        htmltools::tags$line(
          id = 'cline1',
          x1 = 0,
          x2 = width,
          y1 = 0,
          y2 = height,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'cline2',
          x1 = 0,
          x2 = width,
          y1 = height,
          y2 = 0,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'open-diamond' =  htmltools::tags$polygon(
        id = 'diamond',
        points = drawDiamond(width = width, height = height,
          offset = strokeWidth),
        stroke = color,
        fill = 'transparent',
        'stroke-opacity' = opacity,
        ...
      ),
      'open-down-triangle' = htmltools::tags$polygon(
        id = 'triangle',
        points = drawTriangle(width = width, height = height,
          offset = strokeWidth),
        stroke = color,
        fill = 'transparent',
        'stroke-opacity' = opacity,
        transform = sprintf('rotate(180 %f %f)', height / 2 + strokeWidth,
          width / 2 + strokeWidth),
        ...
      ),
      'cross-rect' = htmltools::tags$g(
        htmltools::tags$line(
          id = 'cline1',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = strokeWidth,
          y2 = height + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'cline2',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = height + strokeWidth,
          y2 = strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$rect(
          id = 'open-rect',
          x = strokeWidth,
          y = strokeWidth,
          height = height,
          width = width,
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'simple-star' = htmltools::tags$g(
        htmltools::tags$line(
          id = 'pline1',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = height / 2 + strokeWidth,
          y2 = height / 2 + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'pline2',
          x1 = width / 2 + strokeWidth,
          x2 = width / 2 + strokeWidth,
          y1 = strokeWidth,
          y2 = height + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'cline1',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = strokeWidth,
          y2 = height + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'cline2',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = height + strokeWidth,
          y2 = strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'plus-diamond' = htmltools::tags$g(
        htmltools::tags$line(
          id = 'pline1',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = height / 2 + strokeWidth,
          y2 = height / 2 + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'pline2',
          x1 = width / 2 + strokeWidth,
          x2 = width / 2 + strokeWidth,
          y1 = strokeWidth,
          y2 = height + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$polygon(
          id = 'diamond',
          points = drawDiamond(width = width, height = height,
            offset = strokeWidth),
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'plus-circle' = htmltools::tags$g(
        htmltools::tags$line(
          id = 'pline1',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = height / 2 + strokeWidth,
          y2 = height / 2 + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'pline2',
          x1 = width / 2 + strokeWidth,
          x2 = width / 2 + strokeWidth,
          y1 = strokeWidth,
          y2 = height + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$circle(
          id = 'circle',
          cx = height / 2 + strokeWidth,
          cy = height / 2 + strokeWidth,
          r = height / 2,
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'hexagram' = htmltools::tags$g(
        transform = sprintf('translate(%f %f)', strokeWidth,
          strokeWidth + height * (1 - hexPercentOffset) / 2),
        htmltools::tags$polygon(
          id = 'triangle',
          points = drawTriangle(width = width * hexPercentOffset,
            height = height * hexPercentOffset,
            offset = 0),
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          transform = sprintf('rotate(180 %f %f) translate(%f %f)',
            height * hexPercentOffset / 2,
            width * hexPercentOffset / 2,
            -width * (1 - hexPercentOffset) / 2,
            -height * (1 - hexPercentOffset) / 2),
          ...
        ),
        htmltools::tags$polygon(
          id = 'triangle',
          points = drawTriangle(width = width * hexPercentOffset,
            height = height * hexPercentOffset,
            offset = 0),
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          transform = sprintf('translate(%f %f)',
            width * (1 - hexPercentOffset) / 2,
            -height * (1 - hexPercentOffset) / 2),
          ...
        )
      ),
      'plus-rect' = htmltools::tags$g(
        htmltools::tags$line(
          id = 'pline1',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = height / 2 + strokeWidth,
          y2 = height / 2 + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'pline2',
          x1 = width / 2 + strokeWidth,
          x2 = width / 2 + strokeWidth,
          y1 = strokeWidth,
          y2 = height + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$rect(
          id = 'open-rect',
          x = strokeWidth,
          y = strokeWidth,
          height = height,
          width = width,
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'cross-circle' = htmltools::tags$g(
        htmltools::tags$line(
          id = 'cline1',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = strokeWidth,
          y2 = height + strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$line(
          id = 'cline2',
          x1 = strokeWidth,
          x2 = width + strokeWidth,
          y1 = height + strokeWidth,
          y2 = strokeWidth,
          stroke = color,
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$circle(
          id = 'circle',
          cx = height / 2 + strokeWidth,
          cy = height / 2 + strokeWidth,
          r = height / 2,
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'triangle-rect' = htmltools::tags$g(
        htmltools::tags$polygon(
          id = 'triangle',
          points = drawTriangle(width = width, height = height,
            offset = strokeWidth),
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        ),
        htmltools::tags$rect(
          id = 'open-rect',
          x = strokeWidth,
          y = strokeWidth,
          height = height,
          width = width,
          stroke = color,
          fill = 'transparent',
          'stroke-opacity' = opacity,
          ...
        )
      ),
      'solid-rect' = htmltools::tags$rect(
        id = 'rect',
        x = strokeWidth,
        y = strokeWidth,
        height = height,
        width = width,
        stroke = 'transparent',
        fill = coalesceMissing(fillColor, color),
        'fill-opacity' = fillOpacity,
        ...
      ),
      'solid-circle-md' = htmltools::tags$circle(
        id = 'circle',
        cx = height / 2 + strokeWidth,
        cy = height / 2 + strokeWidth,
        r =  height *  3 / 4 / 2,
        stroke = 'transparent',
        fill = coalesceMissing(fillColor, color),
        'fill-opacity' = fillOpacity,
        ...
      ),
      'solid-triangle' = htmltools::tags$polygon(
        id = 'triangle',
        points = drawTriangle(width = width, height = height,
          offset = strokeWidth),
        stroke = 'transparent',
        fill = coalesceMissing(fillColor, color),
        'fill-opacity' = fillOpacity,
        ...
      ),
      'solid-diamond' = htmltools::tags$polygon(
        id = 'diamond',
        points = drawDiamond(width = width, height = height,
          offset = strokeWidth),
        stroke = 'transparent',
        fill = coalesceMissing(fillColor, color),
        'fill-opacity' = fillOpacity,
        ...
      ),
      'solid-circle-bg' = htmltools::tags$circle(
        id = 'circle',
        cx = height / 2 + strokeWidth,
        cy = height / 2 + strokeWidth,
        r =  height *  4 / 4 / 2,
        stroke = 'transparent',
        fill = coalesceMissing(fillColor, color),
        'fill-opacity' = fillOpacity,
        ...
      ),
      'solid-circle-sm' = htmltools::tags$circle(
        id = 'circle',
        cx = height / 2 + strokeWidth,
        cy = height / 2 + strokeWidth,
        r = height *  2 / 4 / 2,
        stroke = 'transparent',
        fill = coalesceMissing(fillColor, color),
        'fill-opacity' = fillOpacity,
        ...
      ),
      'circle' = htmltools::tags$circle(
        id = 'circle',
        cx = height / 2 + strokeWidth,
        cy = height / 2 + strokeWidth,
        r = height / 2,
        stroke = color,
        fill = fillColor,
        'stroke-opacity' = opacity,
        'fill-opacity' = fillOpacity,
        ...
      ),
      'rect' = htmltools::tags$rect(
        id = 'rect',
        x = strokeWidth,
        y = strokeWidth,
        height = height,
        width = width,
        stroke = color,
        fill = fillColor,
        'stroke-opacity' = opacity,
        'fill-opacity' = fillOpacity,
        ...
      ),
      'diamond' = htmltools::tags$polygon(
        id = 'diamond',
        points = drawDiamond(width = width, height = height,
          offset = strokeWidth),
        stroke = color,
        fill = fillColor,
        'stroke-opacity' = opacity,
        'fill-opacity' = fillOpacity,
        ...
      ),
      'triangle' = htmltools::tags$polygon(
        id = 'triangle',
        points = drawTriangle(width = width, height = height,
          offset = strokeWidth),
        stroke = color,
        fill = fillColor,
        'stroke-opacity' = opacity,
        'fill-opacity' = fillOpacity,
        ...
      ),
      'down-triangle' = htmltools::tags$polygon(
        id = 'triangle',
        points = drawTriangle(width = width, height = height,
          offset = strokeWidth),
        stroke = color,
        fill = fillColor,
        'stroke-opacity' = opacity,
        'fill-opacity' = fillOpacity,
        transform = sprintf('rotate(180 %f %f)', height / 2 + strokeWidth,
          width / 2 + strokeWidth),
        ...
      )
    )
  if (is.numeric(shape)) {
    shape <- shape + 1L
  } else {
    if (!shape %in% names(pchShape)) {
      stop(sprintf('"%s" is not a valid pch name', shape))
    }
  }
  pchShape[[shape]]
}
specialSvg <- function(shape, width, height, color, fillColor, opacity,
  fillOpacity, ...) {
  strokeWidth <- 1
  if ( shape %in% 'text' ) {
    strokeWidth <- 0
  }
  if ( 'stroke-width' %in% names(list(...)) ) {
    strokeWidth <- list(...)[['stroke-width']]
  }
  switch(
    shape,
    'text' = htmltools::tags$text(
      id = 'text',
      x = '50%',
      y = '50%',
      'dominant-baseline' = 'central',
      'text-anchor' = 'middle',
      'font-size' = paste0(round(min(width, height) * 0.6), 'px'),
      # 'font-family' = 'sans-serif',
      'textLength' = width,
      'lengthAdjust' = 'spacingAndGlyphs',
      fill = fillColor,
      'fill-opacity' = fillOpacity,
      stroke = color,
      'stroke-opacity' = opacity,
      'stroke-width' = strokeWidth,
      'abc',
      ...
    ),
    stop('Invalid shape argument.')
  )
}
.makeSymbolFigure <- function(shape, dir = 'man/figures', color = 'black',
    fillColor = NULL, opacity = 1, fillOpacity = 1, ...) {
  shapes <- availableShapes()
  if (is.null(fillColor)) {
    fillColor <- 'transparent'
    if (shape %in% shapes[['special']]) {
      fillColor <- color
    }
  }
  strokeWidth <- 2
  inner <- 50
  total <- inner + strokeWidth * 2
  label_y <- total + 20
  shapeElement <- makeSymbolElement(
    shape = shape,
    width = inner,
    height = inner,
    color = color,
    fillColor = fillColor,
    opacity = opacity,
    fillOpacity = fillOpacity,
    'stroke-width' = strokeWidth,
    ...
  )
  svgTag <- htmltools::tags$svg(
    xmlns = 'http://www.w3.org/2000/svg',
    version = '1.1',
    width = total,
    height = label_y,
    style = 'background-color: white;',
    shapeElement,
    htmltools::tags$text(
      x = total / 2,
      y = label_y - 4,
      'font-family' = 'sans-serif',
      'text-anchor' = 'middle',
      'font-size' = '12px',
      shape
    )
  )
  isPchOnly <- shape %in% shapes[['pch']] &&
    !shape %in% c(shapes[['default']], shapes[['special']])
  suffix <- '-pch.svg'
  if (!isPchOnly) {
    suffix <- '.svg'
  }
  filename <- sprintf('%s%s', shape, suffix)
  writeLines(as.character(svgTag), file.path(dir, filename))
}
coalesceMissing <- function(x, y) {
  if (missing(x)) y else x
}
#' @param svg
#'
#' inner svg tags for symbol
#'
#' @name mapSymbols
#'
#' @export
#'
makeSvgUri <- function(svg, width, height, strokeWidth) {
  svgURI <-
    sprintf('data:image/svg+xml,%s',
      utils::URLencode(as.character(
        htmltools::tags$svg(
          xmlns = "http://www.w3.org/2000/svg",
          version = "1.1",
          width = width + strokeWidth * 2,
          height = height + strokeWidth * 2,
          svg
        )
      ), reserved = TRUE))
  structure(svgURI, class = c(class(svgURI), 'svgURI'))
}

makeLegendSymbol <- function(label, labelStyle,
  imgStyle = "vertical-align: middle; margin: 1px;", ...) {
  shapeTag <- makeSymbol(...)
  htmltools::tagList(
    htmltools::tags$img(src = shapeTag,
                        style = imgStyle),
    htmltools::tags$span(label,
                         style =
                           sprintf("vertical-align: middle; padding: 1px; %s",
                                         labelStyle))
  )
}

drawPlus <- function(width, height, offset = 0) {
  x <- width * c(rep(c(.4, 0, .4, .6, 1, .6), each = 2), .4) + offset
  y <- height * c(0, rep(c(.4, .6, 1, .6, .4, 0), each = 2)) + offset
  paste(x, y, sep = ',', collapse = ' ')
}

drawDiamond <- function(width, height, offset = 0) {
  x <- width * c( .5, 0, .5, 1, .5) + offset
  y <- height * c(0, .5, 1, .5, 0) + offset
  paste(x, y, sep = ',', collapse = ' ')
}

drawCross <- function(width, height, offset = 0) {
  a <- sqrt(2) / 10
  x <- width *  c(a, 0, .5 - a, 0, a, .5, 1 - a, 1, .5 + a, 1, 1 - a, .5, a) +
    offset
  y <- height * c(0, a, .5, 1 - a, 1, .5 + a, 1, 1 - a, .5, a, 0, .5 - a, 0) +
    offset
  paste(x, y, sep = ',', collapse = ' ')
}
drawStar <- function(width, height, offset = 0) {
  x <- width * c(0.4, 0.4, 0.1414214, 0, 0.2585786, 0, 0, 0.2585786, 0,
                 0.1414214, 0.4, 0.4, 0.6, 0.6, 0.8585786, 1, 0.7414214, 1, 1,
                 0.7414214, 1, 0.8585786, 0.6, 0.6, 0.4) + offset
  y <- height * c(0, 0.2585786, 0, 0.1414214, 0.4, 0.4, 0.6, 0.6, 0.8585786, 1,
                  0.7414214, 1, 1, 0.7414214, 1, 0.8585786, 0.6, 0.6, 0.4, 0.4,
                  0.1414214, 0, 0.2585786, 0, 0) + offset
  paste(x, y, sep = ',', collapse = ' ')
}
drawPolygon <- function(n, width = 1, height = 1, offset = 0) {
  stopifnot(n > 0 || !is.integer(n))
  radians <- seq(-pi, pi, by = 2 * pi / n)
  if ( n %% 2 == 0 ) {
    x <- (cos(radians) + 1) * 1 / 2 * width + offset
    y <- (sin(radians) + 1) * 1 / 2 * height + offset
  } else {
    radians <- seq(-pi, pi, by = 2 * pi / n)
    x <- (sin(radians) + 1) * 1 / 2 * width + offset
    y <- (cos(radians) + 1) * 1 / 2 * height + offset
  }
  paste(x, y, sep = ',', collapse = ' ')
}
drawTriangle <- function(width, height, offset) {
  sprintf('%s,%s %s,%s %s,%s',
    offset,
    height + offset,
    width + offset,
    height + offset,
    width / 2  + offset,
    offset)
}

#' @export
#'
#' @rdname mapSymbols
makeSymbolIcons <- function(shape,
  color,
  fillColor = color,
  opacity,
  fillOpacity = opacity,
  strokeWidth = 1,
  width,
  height = width,
  label = NULL,
  ...) {
  args <- list(
    makeSymbol,
    shape = shape,
    width = width,
    height = height,
    color = color,
    fillColor = fillColor,
    opacity = opacity,
    fillOpacity = fillOpacity,
    `stroke-width` = strokeWidth,
    ...
  )
  if (!is.null(label)) {
    args <- append(args, list(label = label))
  }
  symbols <- do.call(Map, args)
  leaflet::icons(
    iconUrl = unname(symbols),
    iconAnchorX = width / 2 + strokeWidth,
    iconAnchorY = height / 2 + strokeWidth
  )
}
#' @param map
#'
#' a map widget object created from 'leaflet'
#'
#' @param lng
#'
#' a numeric vector of longitudes, or a one-sided formula of the form \code{~x}
#' where \code{x} is a variable in \code{data}; by default
#' (if not explicitly provided), it will be automatically inferred from data
#' by looking for a column named \code{lng}, \code{long}, or \code{longitude}
#' (case-insensitively)
#'
#' @param lat
#'
#' a vector of latitudes or a formula (similar to the \code{lng} argument; the
#' names \code{lat} and \code{latitude} are used when guessing the latitude
#' column from \code{data})
#'
#' @param values
#'
#' the values used to generate shapes; can be omitted for a single type of
#' shape
#'
#' @param shape
#'
#' the desired shape of the symbol, See \link[leaflegend]{availableShapes}
#'
#' @param color
#'
#' stroke color
#'
#' @param fillColor
#'
#' fill color
#'
#' @param opacity
#'
#' stroke opacity
#'
#' @param fillOpacity
#'
#' fill opacity
#'
#' @param strokeWidth
#'
#' stroke width in pixels
#'
#' @param width
#'
#' in pixels
#'
#' @param height
#'
#' in pixels
#'
#' @param dashArray
#'
#' a string or vector/list of strings that defines the stroke dash pattern
#'
#' @param label
#'
#' a character vector of labels to display at the center of each symbol
#'
#' @param data
#'
#' the data object from which the argument values are derived; by default, it
#' is the \code{data} object provided to \code{leaflet()} initially, but can be
#' overridden
#'
#' @param ...
#'
#' arguments to be passed to \link[leaflet]{addMarkers}
#'
#' @export
#'
#' @rdname mapSymbols
addSymbols <- function(
    map,
    lng,
    lat,
    values,
    shape,
    color,
    fillColor = color,
    opacity = 1,
    fillOpacity = opacity,
    strokeWidth = 1,
    width = 20,
    height = width,
    dashArray = NULL,
    label = NULL,
    data = leaflet::getMapData(map),
    ...
) {
  if ( missing(shape) ) {
    shape <- availableShapes()[['default']]
  }
  if ( !missing(values) ) {
    values <- as.factor(parseValues(values, data))
    if ( length(levels(values)) > length(shape) ) {
      stop('values has more factor levels than shape. Maximum levels is 7')
    }
    shape <- shape[values]
  } else {
    shape <- shape[1]
  }
  color <- parseValues(color, data)
  fillColor <- parseValues(fillColor, data)
  label <- parseValues(label, data)
  if ( is.null(dashArray) ) {
    dashArray <- 'none'
  }
  args <- list(shape = shape, color = color,
               fillColor = fillColor, opacity = opacity,
               fillOpacity = fillOpacity,
               strokeWidth = strokeWidth, width = width,
               height = width,
               `stroke-dasharray` = dashArray)
  if (!is.null(label)) {
    args <- append(args, list(label = label))
  }
  iconSymbols <- do.call(makeSymbolIcons, args)
  if (!missing(lng) && !missing(lat)) {
    leaflet::addMarkers(map = map, lng = lng, lat = lat, icon = iconSymbols,
      data = data, ...)
  } else {
    leaflet::addMarkers(map = map, icon = iconSymbols, data = data, ...)
  }
}
#' @export
#'
#' @rdname mapSymbols
addSymbolsSize <- function(
    map,
    lng,
    lat,
    values,
    shape,
    color,
    fillColor = color,
    opacity = 1,
    fillOpacity = opacity,
    strokeWidth = 1,
    baseSize = 20,
    minSize = NULL,
    maxSize = NULL,
    data = leaflet::getMapData(map),
    ...
) {
  values <- parseValues(values, data)
  sizes <- sizeNumeric(values, baseSize, minSize = minSize, maxSize = maxSize)
  color <- parseValues(color, data)
  fillColor <- parseValues(fillColor, data)
  if (!missing(lng) && !missing(lat)) {
    addSymbols(map = map,  lng = lng, lat = lat, shape = shape, color = color,
      fillColor = fillColor, opacity = opacity,
      fillOpacity = fillOpacity, strokeWidth = strokeWidth,
      width = sizes, data = data, ...)
  } else {
    addSymbols(map = map, shape = shape, color = color, fillColor = fillColor,
      opacity = opacity, fillOpacity = fillOpacity, strokeWidth = strokeWidth,
      width = sizes, data = data, ...)
  }
}

#' Add Customizable Color Legends to a 'leaflet' map widget
#'
#' Functions for more control over the styling of 'leaflet' legends.
#' The 'leaflet'
#' map is passed through and the output is a 'leaflet' control so that
#' the legends are integrated with other functionality of the API. Style
#' the text of the labels, the symbols used, orientation of the legend items,
#' and sizing of all elements.
#'
#' @param map
#'
#' a map widget object created from 'leaflet'
#'
#' @param pal
#'
#' the color palette function, generated from \link[leaflet]{colorNumeric}
#'
#' @param values
#'
#' the values used to generate colors from the palette function
#'
#' @param bins
#'
#' an approximate number of tick-marks on the color gradient for the
#' colorNumeric palette if it is of length one; you can also provide a
#' numeric vector as the pre-defined breaks
#'
#' @param title
#'
#' the legend title, pass in HTML to style
#'
#' @param shape
#'
#' the desired shape of the symbol, See \link[leaflegend]{availableShapes}
#'
#' @param orientation
#'
#' stack the legend items vertically or horizontally
#'
#' @param width
#'
#' in pixels
#'
#' @param height
#'
#' in pixels
#'
#' @param numberFormat
#'
#' formatting functions for numbers that are displayed e.g. format, prettyNum
#'
#' @param labelStyle
#'
#' character string of style argument for HTML text
#'
#' @param tickLength
#'
#' in pixels
#'
#' @param tickWidth
#'
#' in pixels
#'
#' @param decreasing
#'
#' order of numbers in the legend
#'
#' @param opacity
#'
#' opacity of the legend items
#'
#' @param fillOpacity
#'
#' fill opacity of the legend items
#'
#' @param group
#'
#' group name of a leaflet layer group
#'
#' @param labels
#'
#' labels
#'
#' @param naLabel
#'
#' the legend label for NAs in values
#'
#' @param className
#'
#' extra CSS class to append to the control, space separated
#'
#' @param data a data object. Currently supported objects are matrices, data
#'   frames, spatial objects from the \pkg{sp} package
#'   (\code{SpatialPoints}, \code{SpatialPointsDataFrame}, \code{Polygon},
#'   \code{Polygons}, \code{SpatialPolygons}, \code{SpatialPolygonsDataFrame},
#'   \code{Line}, \code{Lines}, \code{SpatialLines}, and
#'   \code{SpatialLinesDataFrame}), and
#'   spatial data frames from the \pkg{sf} package.
#'
#' @param ...
#'
#' arguments to pass to \link[leaflet]{addControl}
#'
#' @export
#'
#' @return
#'
#' an object from \link[leaflet]{addControl}
#'
#' @name addLeafLegends
#'
#' @examples
#' library(leaflet)
#'
#' data(quakes)
#'
#' # Numeric Legend
#'
#' numPal <- colorNumeric('viridis', quakes$depth)
#' leaflet() %>%
#'   addTiles() %>%
#'   addLegendNumeric(
#'     pal = numPal,
#'     values = quakes$depth,
#'     position = 'topright',
#'     title = 'addLegendNumeric (Horizontal)',
#'     orientation = 'horizontal',
#'     shape = 'rect',
#'     decreasing = FALSE,
#'     bins = 5,
#'     height = 20,
#'     width = 150
#'   ) %>%
#'   addLegendNumeric(
#'     pal = numPal,
#'     values = quakes$depth,
#'     position = 'topright',
#'     title = htmltools::tags$div('addLegendNumeric (Decreasing)',
#'     style = 'font-size: 24px; text-align: center; margin-bottom: 5px;'),
#'     orientation = 'vertical',
#'     shape = 'stadium',
#'     decreasing = TRUE,
#'     height = 100,
#'     width = 20
#'   ) %>%
#'   addLegend(pal = numPal, values = quakes$depth, title = 'addLegend')
#'
#' # Quantile Legend
#' # defaults to adding quantile numeric break points
#'
#' quantPal <- colorQuantile('viridis', quakes$mag, n = 5)
#' leaflet() %>%
#'   addTiles() %>%
#'   addCircleMarkers(data = quakes,
#'                    lat = ~lat,
#'                    lng = ~long,
#'                    color = ~quantPal(mag),
#'                    opacity = 1,
#'                    fillOpacity = 1
#'   ) %>%
#'   addLegendQuantile(pal = quantPal,
#'                     values = quakes$mag,
#'                     position = 'topright',
#'                     title = 'addLegendQuantile',
#'                     numberFormat = function(x) {prettyNum(x, big.mark = ',',
#'                     scientific = FALSE, digits = 2)},
#'                     shape = 'circle') %>%
#'   addLegendQuantile(pal = quantPal,
#'                     values = quakes$mag,
#'                     position = 'topright',
#'                     title = htmltools::tags$div('addLegendQuantile',
#'                                                 htmltools::tags$br(),
#'                                                 '(Omit Numbers)'),
#'                     numberFormat = NULL,
#'                     shape = 'circle') %>%
#'   addLegend(pal = quantPal, values = quakes$mag, title = 'addLegend')
#'
#' # Factor Legend
#' # Style the title with html tags, several shapes are supported drawn with svg
#'
#' quakes[['group']] <- sample(c('A', 'B', 'C'), nrow(quakes), replace = TRUE)
#' factorPal <- colorFactor('Dark2', quakes$group)
#' leaflet() %>%
#'   addTiles() %>%
#'   addCircleMarkers(
#'     data = quakes,
#'     lat = ~ lat,
#'     lng = ~ long,
#'     color = ~ factorPal(group),
#'     opacity = 1,
#'     fillOpacity = 1
#'   ) %>%
#'   addLegendFactor(
#'     pal = factorPal,
#'     title = htmltools::tags$div('addLegendFactor', style = 'font-size: 24px;
#'     color: red;'),
#'     values = quakes$group,
#'     position = 'topright',
#'     shape = 'triangle',
#'     width = 50,
#'     height = 50
#'   ) %>%
#'   addLegend(pal = factorPal,
#'             values = quakes$group,
#'             title = 'addLegend')
#'
#' # Bin Legend
#' # Restyle the text of the labels, change the legend item orientation
#'
#' binPal <- colorBin('Set1', quakes$mag)
#' leaflet(quakes) %>%
#'   addTiles() %>%
#'   addCircleMarkers(
#'     lat = ~ lat,
#'     lng = ~ long,
#'     color = ~ binPal(mag),
#'     opacity = 1,
#'     fillOpacity = 1
#'   ) %>%
#'   addLegendBin(
#'     pal = binPal,
#'     position = 'topright',
#'     values = ~mag,
#'     title = 'addLegendBin',
#'     labelStyle = 'font-size: 18px; font-weight: bold;',
#'     orientation = 'horizontal'
#'   ) %>%
#'   addLegend(pal = binPal,
#'             values = quakes$mag,
#'             title = 'addLegend')
#'
#' # Group Layer Control
#' # Works with baseGroups and overlayGroups
#'
#' leaflet() %>%
#'   addTiles() %>%
#'   addLegendNumeric(
#'     pal = numPal,
#'     values = quakes$depth,
#'     position = 'topright',
#'     title = 'addLegendNumeric',
#'     group = 'Numeric Data'
#'   ) %>%
#'   addLegendQuantile(
#'     pal = quantPal,
#'     values = quakes$mag,
#'     position = 'topright',
#'     title = 'addLegendQuantile',
#'     group = 'Quantile'
#'   ) %>%
#'   addLegendBin(
#'     data = quakes,
#'     pal = binPal,
#'     position = 'bottomleft',
#'     title = 'addLegendBin',
#'     group = 'Bin',
#'     values = ~mag
#'   ) %>%
#'   addLayersControl(
#'     baseGroups = c('Numeric Data', 'Quantile'),  overlayGroups = c('Bin'),
#'     position = 'bottomright'
#'   )
addLegendNumeric <- function(map,
                             pal,
                             values,
                             title = NULL,
                             shape = c('rect', 'stadium'),
                             orientation = c('vertical', 'horizontal'),
                             width = 20,
                             height = 100,
                             bins = 7,
                             numberFormat = function(x) {
                               prettyNum(x, format = 'f', big.mark = ',',
                                         digits = 3, scientific = FALSE)
                               },
                             tickLength = 4,
                             tickWidth = 1,
                             decreasing = FALSE,
                             fillOpacity = 1,
                             group = NULL,
                             labels = NULL,
                             naLabel = 'NA',
                             labelStyle = '',
                             className = 'info legend leaflet-control',
                             data = leaflet::getMapData(map),
                             ...) {
  stopifnot(is.logical(decreasing))
  stopifnot(attr(pal, 'colorType') == 'numeric')
  stopifnot(is.numeric(width) && is.numeric(height) && width >= 0 &&
               height >= 0)
  stopifnot(is.numeric(tickLength) && is.numeric(tickWidth) &&
               tickLength >= 0 && tickWidth >= 0)
  shape <- match.arg(shape)
  id <- sprintf('gradient-%s-%d',
                gsub('[[:punct:]]|\\s', '', deparse(match.call()[['values']])),
                length(map[["x"]][["calls"]]) + 1)
  values <- parseValues(values = values, data = data)
  rng <- range(values, na.rm = TRUE)
  bins <- parseValues(values = bins, data = data)
  if (length(bins) > 1) {
    if (!all(bins >= rng[1] & bins <= rng[2])) {
      stop('Bins are outside range of values.')
    }
    breaks <- sort(c(rng, bins))
  } else {
    breaks <- pretty(values, bins)
  }
  if (breaks[1] < rng[1]) {
    breaks[1] <- rng[1]
  }
  if (breaks[length(breaks)] > rng[2]) {
    breaks[length(breaks)] <- rng[2]
  }
  hasNa <- any(is.na(values))
  orientation <- match.arg(orientation)
  isVertical <- as.integer(orientation == 'vertical')
  isHorizontal <- as.integer(orientation == 'horizontal')
  offsets <- seq(rng[1], rng[2], length.out = 10)
  if (decreasing) {
    breaks <- rev(breaks)
    offsets <- rev(offsets)
    stdBreaks <- (1 - (breaks - rng[1]) / diff(rng)) *
      (height * isVertical + width * isHorizontal)
  } else {
    stdBreaks <- (breaks - rng[1]) / diff(rng) *
      (height * isVertical + width * isHorizontal)
  }
  if (length(breaks) > 2) {
    i <- seq(2L, length(breaks) - 1L, 1L)
  } else {
    i <- c(1, length(breaks))
  }
  if (is.null(labels)) {
    labels <- numberFormat(breaks)[i]
  }
  if (isVertical) {
    labels <- rev(labels)
  }
  ticks <- makeTicks(breaks = stdBreaks[i], width = tickLength,
    height = height, strokeWidth = tickWidth, stroke = 'black', transform =
      sprintf('translate(%.03f,%.03f)', width * isVertical,
        height * isHorizontal),
    orientation = orientation)
  tickText <- makeTickText(labels =  labels, breaks = stdBreaks[i],
    width = width, height = height, orientation = orientation)
  svgGradient <- makeGradient(breaks = offsets,
    pal = pal,height = height, width = width, id = id,
    fillOpacity = fillOpacity, orientation = orientation, shape)
  hasHorizontalTickLabels <- isHorizontal && length(labels) > 2
  htmlElements <- assembleLegendWithTicks(
    width = width + (isVertical * tickLength * 2),
    height = height + (isHorizontal * tickLength * 2),
    svgElements = svgGradient, ticks = ticks, tickText = tickText,
    labelStyle = labelStyle,
    marginLeft = ifelse(hasHorizontalTickLabels,
                        nchar(labels[1]) * .25, 0),
    marginRight = ifelse(isVertical, max(nchar(labels)) * .5,
                  ifelse(hasHorizontalTickLabels,
                         nchar(labels[length(labels)]) * .25, 0)),
    marginBottom = ifelse(isHorizontal, 1, 0))
  naSize <- width * isVertical + height * isHorizontal
  htmlElements <- addNa(hasNa = hasNa, htmlElements = htmlElements,
    shape = shape, labels = naLabel, colors = pal(NA), labelStyle = labelStyle,
    height = naSize, width = naSize, opacity = fillOpacity,
    fillOpacity = fillOpacity, strokeWidth = 0)
  htmlElements <- addTitle(title = title, htmlElements = list(htmlElements))
  leaflegendAddControl(map, html = htmlElements, className = className,
    group = group, ...)
}

makeGradient <- function(breaks, pal, height, width, id, fillOpacity,
  orientation, shape) {
  stops <- (breaks - min(breaks)) /
    (max(breaks) - min(breaks))
  colors <- pal(breaks)[order(stops)]
  stops <- sort(stops)
  offsets <- sprintf('%.03f%%', 100 * stops)
  curvePercent <- ifelse(shape == 'stadium', '10%', '0')
  if (orientation == 'vertical') {
    htmltools::tagList(
      htmltools::tags$defs(
        htmltools::tags$linearGradient(
          id = id,
          x1 = 0, y1 = 0, x2 = 0, y2 = 1,
          htmltools::tagList(Map(htmltools::tags$stop,
            offset = offsets,
            'stop-color' = colors))
        )
      ),
      htmltools::tags$g(
        htmltools::tags$rect(height = height, width = width, x = 0,
          rx = curvePercent, 'fill-opacity' = fillOpacity,
          fill = sprintf('url(#%s)', id))
      )
    )
  } else {
    htmltools::tagList(
      htmltools::tags$defs(
        htmltools::tags$linearGradient(
          id = id,
          x1 = 0, y1 = 0, x2 = 1, y2 = 0,
          htmltools::tagList(Map(htmltools::tags$stop,
            offset = offsets,
            'stop-color' = colors))
        )
      ),
      htmltools::tags$g(
        htmltools::tags$rect(height = height, width = width, x = 0,
          ry = curvePercent, 'fill-opacity' = fillOpacity,
          fill = sprintf('url(#%s)', id))
      )
    )
  }
}

makeTicks <- function(breaks, width, height, strokeWidth, orientation, ...) {
  if (orientation == 'vertical') {
    tickLocations <- height - breaks
    ticks <- Map(htmltools::tags$line, x1 = 0,
      x2 = width, y1 = tickLocations, y2 = tickLocations,
      `stroke-width` = strokeWidth,
      ...)
  } else {
    tickLocations <- breaks
    ticks <- Map(htmltools::tags$line, x1 = tickLocations, x2 = tickLocations,
      y1 = 0, y2 = width, `stroke-width` = strokeWidth, ...)
  }
  ticks
}
makeTickText <- function(labels, breaks, width, height, orientation) {
  if (orientation == 'vertical') {
    tickLocations <- height - breaks
    Map(
      htmltools::p,
      labels,
      style = sprintf('position: absolute; margin: 0; top: calc(%.2fpx - .5em);
        right: 0; line-height:1;',
        tickLocations)
    )
  } else if (length(labels) > 2) {
    tickLocations <- breaks
    halfWidthEm <- nchar(labels) * .25
    Map(
      htmltools::p,
      labels,
      style = sprintf(
        'position: absolute; margin: 0; left: calc(%.2fpx + 1px - %sem); bottom: 0;
        white-space: nowrap; line-height:1;',
        tickLocations, halfWidthEm)
    )
  } else {
    Map(
      htmltools::p,
      labels,
      style = sprintf('position: absolute; margin: 0; %s: 0; bottom: 0;
        line-height:1;',
        c('left', 'right'))
    )
  }

}
assembleLegendWithTicks <- function(width, height, svgElements, ticks, tickText,
  labelStyle, marginRight, marginBottom, marginLeft = 0) {
  htmlElements <- htmltools::tags$svg(
    xmlns = "http://www.w3.org/2000/svg",
    version = "1.1",
    width = width,
    height = height,
    htmltools::tagList(svgElements, ticks)
  )
  htmlElements <- htmltools::tags$img(src = makeSvgUri(htmlElements,
    width = width, height = height, strokeWidth = 0),
    style = 'margin-left: 1px;')
  if (marginLeft > 0) {
    inner <- htmltools::tags$div(
      style = sprintf(
        'position: relative; width: calc(%spx + 2px); height: calc(%spx + %sem);',
        width, height, marginBottom),
      htmlElements,
      tickText
    )
    htmltools::tags$div(
      style = sprintf(
        'display: inline-block; margin-top:.5em; margin-bottom:.5em; %s;
        padding-left:%sem; padding-right:%sem;',
        labelStyle, marginLeft, marginRight),
      inner
    )
  } else {
    htmltools::tags$div(
      style = sprintf(
        'position: relative; margin-top:.5em; margin-bottom:.5em; %s;
      width: calc(%spx + %sem + 2px); height: calc(%spx + %sem);',
        labelStyle, width, marginRight, height, marginBottom),
      htmlElements,
      tickText
    )
  }
}

addTitle <- function(title, htmlElements) {
  if (is.null(title)) {
    NULL
  } else if (inherits(title, 'shiny.tag')) {
    title <- list(htmltools::div(title))
  } else if (is.character(title)) {
    title <- list(htmltools::div(htmltools::tags$strong(title)))
  } else {
    stop('Title must be character vector or an html tags object')
  }
  htmltools::tagList(title, htmlElements)
}

#' @export
#'
#' @rdname addLeafLegends
#'
addLegendQuantile <- function(map,
                              pal,
                              values,
                              title = NULL,
                              labelStyle = '',
                              shape = 'rect',
                              orientation = c('vertical', 'horizontal'),
                              width = 24,
                              height = 24,
                              numberFormat = function(x) {
                                prettyNum(x, big.mark = ',', scientific = FALSE,
                                          digits = 1)
                                },
                              opacity = 1,
                              fillOpacity = opacity,
                              group = NULL,
                              className = 'info legend leaflet-control',
                              naLabel = 'NA',
                              between = ' - ',
                              data = leaflet::getMapData(map),
                              ...) {
  stopifnot( attr(pal, 'colorType') == 'quantile' )
  stopifnot( width >= 0 && height >= 0 )
  orientation <- match.arg(orientation)
  probs <- attr(pal, 'colorArgs')[['probs']]
  values <- parseValues(values = values, data = data)
  if ( is.null(numberFormat) ) {
    labels <- sprintf(' %3.0f%%%s%3.0f%%', probs[-length(probs)] * 100, between,
                      probs[-1] * 100)
  } else {
    breaks <- stats::quantile(x = values, probs = probs, na.rm = TRUE)
    labels <- numberFormat(breaks)
    labels <- sprintf('%3.0f%%%s%3.0f%% (%s%s%s)',
                    probs[-length(probs)] * 100,
                    between,
                    probs[-1] * 100,
                    labels[-length(labels)],
                    between,
                    labels[-1])
  }
  colors <- unique(pal(sort(values)))
  htmlElements <- makeLegendCategorical(shape = shape, labels = labels,
    colors = colors,
    labelStyle = labelStyle,
    height = height, width = width,
    opacity = opacity,
    fillOpacity = fillOpacity,
    orientation = orientation,
    title = title,
    hasNa = any(is.na(values)),
    naLabel = naLabel,
    naColor = pal(NA))
  leaflegendAddControl(map, html = htmltools::tagList(htmlElements),
                       className = className, group = group, ...)
}

#' @param between
#'
#' a separator between legend range labels
#'
#' @param labelCutpoints
#'
#' if \code{TRUE}, labels are placed at bin boundaries (cutpoints) with tick
#' marks instead of beside each symbol. Only supported for vertical
#' orientation.
#'
#' @param tickLength
#'
#' length of tick marks in pixels, used when \code{labelCutpoints = TRUE}
#'
#' @param tickWidth
#'
#' stroke width of tick marks in pixels, used when \code{labelCutpoints = TRUE}
#'
#' @export
#'
#' @rdname addLeafLegends
#'
addLegendBin <- function(map,
                         pal,
                         values,
                         title = NULL,
                         labelStyle = '',
                         shape = 'rect',
                         orientation = c('vertical', 'horizontal'),
                         width = 24,
                         height = 24,
                         numberFormat = function(x) {
                           format(round(x, 3), big.mark = ',', trim = TRUE,
                                  scientific = FALSE)
                         },
                         opacity = 1,
                         fillOpacity = opacity,
                         group = NULL,
                         className = 'info legend leaflet-control',
                         naLabel = 'NA',
                         between = ' - ',
                         labelCutpoints = FALSE,
                         tickLength = 4,
                         tickWidth = 1,
                         data = leaflet::getMapData(map),
                         ...) {
  stopifnot( attr(pal, 'colorType') == 'bin' )
  stopifnot( width >= 0 && height >= 0 )
  orientation <- match.arg(orientation)
  if (isTRUE(labelCutpoints) && orientation == 'horizontal')
    stop('labelCutpoints = TRUE is only supported for vertical orientation.')
  values <- parseValues(values = values, data = data)
  bins <- attr(pal, 'colorArgs')[['bins']]
  colors <- pal((bins[-1] + bins[-length(bins)]) / 2 )
  if (isTRUE(labelCutpoints)) {
    htmlElements <- makeLegendBinTicks(
      bins = bins,
      colors = colors,
      shape = shape,
      width = width,
      height = height,
      tickLength = tickLength,
      tickWidth = tickWidth,
      numberFormat = numberFormat,
      labelStyle = labelStyle,
      fillOpacity = fillOpacity,
      title = title,
      hasNa = any(is.na(values)),
      naLabel = naLabel,
      naColor = pal(NA)
    )
  } else {
    labels <- sprintf(' %s%s%s', numberFormat(bins[-length(bins)]), between,
                      numberFormat(bins[-1]))
    htmlElements <- makeLegendCategorical(shape = shape, labels = labels,
      colors = colors,
      labelStyle = labelStyle,
      height = height, width = width,
      opacity = opacity,
      fillOpacity = fillOpacity,
      orientation = orientation,
      title = title,
      hasNa = any(is.na(values)),
      naLabel = naLabel,
      naColor = pal(NA))
  }
  leaflegendAddControl(map, html = htmltools::tagList(htmlElements),
                       className = className, group = group, ...)
}

#' @export
#'
#' @rdname addLeafLegends
#'
addLegendFactor <- function(map,
                            pal,
                            values,
                            title = NULL,
                            labelStyle = '',
                            shape = 'rect',
                            orientation = c('vertical', 'horizontal'),
                            width = 24,
                            height = 24,
                            opacity = 1,
                            fillOpacity = opacity,
                            group = NULL,
                            className = 'info legend leaflet-control',
                            naLabel = 'NA',
                            data = leaflet::getMapData(map),
                            ...) {
  stopifnot( attr(pal, 'colorType') == 'factor' )
  stopifnot( width >= 0 && height >= 0 )
  orientation <- match.arg(orientation)
  values <- parseValues(values = values, data = data)
  hasNa <- any(is.na(values))
  values <- sort(unique(values))
  labels <- sprintf(' %s', values)
  colors <- pal(values)
  htmlElements <- makeLegendCategorical(shape = shape, labels = labels,
                                        colors = colors,
                                        labelStyle = labelStyle,
                                        height = height, width = width,
                                        opacity = opacity,
                                        fillOpacity = fillOpacity,
                                        orientation = orientation,
                                        title = title,
                                        hasNa = hasNa,
                                        naLabel = naLabel,
                                        naColor = pal(NA))
  leaflegendAddControl(map, html = htmltools::tagList(htmlElements),
                       className = className, group = group, ...)
}

makeLegendCategorical <- function(shape, labels, colors, labelStyle, height,
                              width, opacity, fillOpacity, orientation, title,
  hasNa, naLabel, naColor) {
  htmlElements <- Map(
    f = makeLegendSymbol,
    shape = shape,
    label = labels,
    color = colors,
    labelStyle = labelStyle,
    height = height,
    width = width,
    opacity = opacity,
    fillOpacity = fillOpacity,
    'stroke-width' = 1
  )
  if ( orientation == 'vertical' ) {
    htmlElements <- lapply(htmlElements, htmltools::tagList,
                           htmltools::tags$br())
  }
  htmlElements <- addTitle(title = title, htmlElements = htmlElements)
  htmlElements <- addNa(hasNa = hasNa, htmlElements = htmlElements,
    shape = shape, labels = naLabel, colors = naColor, labelStyle = labelStyle,
    height = height, width = width, opacity = fillOpacity,
    fillOpacity = fillOpacity, strokeWidth = 1)
  htmlElements
}

makeLegendBinTicks <- function(bins, colors, shape, width, height, tickLength,
  tickWidth, numberFormat, labelStyle, fillOpacity, title, hasNa, naLabel,
  naColor) {
  nBins <- length(colors)
  totalHeight <- nBins * height
  pad <- ceiling(tickWidth / 2)
  svgHeight <- totalHeight + 2 * pad
  # breaks run high-to-low so tickLocations = svgHeight - breaks maps to
  # y = pad (top boundary) through y = totalHeight + pad (bottom boundary)
  stdBreaks <- seq(totalHeight + pad, pad, by = -height)
  tickLabels <- numberFormat(bins)
  shapeElements <- Map(
    f = makeSymbolElement,
    color = colors,
    fillColor = colors,
    shape = shape, width = width, height = height,
    fillOpacity = fillOpacity, 'stroke-width' = 0
  )
  transforms <- sprintf('translate(0,%g)', pad + seq(0, by = height,
    length.out = nBins))
  shapeElements <- Map(htmltools::tags$g, shapeElements,
    transform = transforms)
  ticks <- makeTicks(breaks = stdBreaks, width = tickLength,
    height = svgHeight, strokeWidth = tickWidth, stroke = 'black',
    transform = sprintf('translate(%.03f,0)', width),
    orientation = 'vertical')
  tickText <- makeTickText(labels = tickLabels, breaks = stdBreaks,
    width = width, height = svgHeight, orientation = 'vertical')
  htmlElements <- assembleLegendWithTicks(
    width = width + tickLength * 2,
    height = svgHeight,
    svgElements = shapeElements,
    ticks = ticks,
    tickText = tickText,
    labelStyle = labelStyle,
    marginRight = max(nchar(tickLabels)) * .5,
    marginBottom = 0
  )
  htmlElements <- addTitle(title = title, htmlElements = list(htmlElements))
  htmlElements <- addNa(hasNa = hasNa, htmlElements = htmlElements,
    shape = shape, labels = naLabel, colors = naColor,
    labelStyle = labelStyle, height = width, width = width,
    opacity = fillOpacity, fillOpacity = fillOpacity, strokeWidth = 0)  
  htmlElements
}

addNa <- function(hasNa, htmlElements, shape, labels, colors,
  labelStyle, height,  width, opacity, fillOpacity, strokeWidth) {
  if (hasNa) {
    naLegend <- list(htmltools::div(
      #style = 'margin-top: .3rem;',
      makeLegendSymbol(
        shape = shape,
        label = labels,
        color = colors,
        labelStyle = labelStyle,
        height = height,
        width = width,
        opacity = opacity,
        fillOpacity = fillOpacity,
        'stroke-width' = strokeWidth,
        imgStyle = 'vertical-align: middle; margin: 1px;'
      )))
    htmlElements <- htmltools::tagList(htmlElements, naLegend)
  }
  htmlElements
}

#' Add a legend for the sizing of symbols or the width of lines
#'
#' @param map
#'
#' a map widget object created from 'leaflet'
#'
#' @param pal
#'
#' the color palette function, generated from \link[leaflet]{colorNumeric}
#'
#' @param values
#'
#' the values used to generate sizes and if colorValues is not specified and
#' pal is given, then the values are used to generate  colors from the palette
#' function
#'
#' @param title
#'
#' the legend title, pass in HTML to style
#'
#' @param shape
#'
#' the desired shape of the symbol, See \link[leaflegend]{availableShapes}
#'
#' @param orientation
#'
#' stack the legend items vertically or horizontally
#'
#'
#' @param labelStyle
#'
#' character string of style argument for HTML text
#'
#'
#' @param opacity
#'
#' opacity of the legend items
#'
#' @param fillOpacity
#'
#' fill opacity of the legend items
#'
#' @param breaks
#'
#' an integer specifying the number of breaks or a numeric vector of the breaks.
#' if a named vector is given, the names are used as labels
#'
#' @param baseSize
#'
#' re-scaling size in pixels of the mean of the values, the average value will
#' be this exact size
#'
#' @param minSize
#'
#' minimum size in pixels of a symbol; values that would scale below this are
#' clamped to \code{minSize}; \code{baseSize} must be greater than \code{minSize}
#'
#' @param maxSize
#'
#' maximum size in pixels of a symbol; values that would scale above this are
#' clamped to \code{maxSize}; \code{baseSize} must be less than \code{maxSize}
#'
#' @param color
#'
#' the color of the legend symbols, if omitted pal is used
#'
#' @param fillColor
#'
#' fill color of symbol
#'
#' @param strokeWidth
#'
#' width of symbol outline
#'
#' @param numberFormat
#'
#' formatting functions for numbers that are displayed e.g. format, prettyNum
#'
#' @param group
#'
#' group name of a leaflet layer group
#'
#' @param className
#'
#' extra CSS class to append to the control, space separated
#'
#' @param stacked
#'
#' If \code{TRUE}, symbols are overlayed onto each other for a more compact
#' size legend
#'
#' @param data a data object. Currently supported objects are matrices, data
#'   frames, spatial objects from the \pkg{sp} package
#'   (\code{SpatialPoints}, \code{SpatialPointsDataFrame}, \code{Polygon},
#'   \code{Polygons}, \code{SpatialPolygons}, \code{SpatialPolygonsDataFrame},
#'   \code{Line}, \code{Lines}, \code{SpatialLines}, and
#'   \code{SpatialLinesDataFrame}), and
#'   spatial data frames from the \pkg{sf} package.
#'
#' @param ...
#'
#' arguments to pass to
#'
#' \link[leaflet]{addControl} for addLegendSize
#'
#' \link[base]{pretty} for sizeBreaks
#'
#' \link[leaflegend]{makeSymbol} for makeSymbolsSize
#'
#' @return
#'
#' an object from \link[leaflet]{addControl}
#'
#' @export
#'
#' @name legendSymbols
#'
#' @examples
#' library(leaflet)
#' data("quakes")
#' quakes <- quakes[1:100,]
#' numPal <- colorNumeric('viridis', quakes$depth)
#' sizes <- sizeNumeric(quakes$depth, baseSize = 10)
#' symbols <- Map(
#'   makeSymbol,
#'   shape = 'triangle',
#'   color = numPal(quakes$depth),
#'   width = sizes,
#'   height = sizes
#' )
#' leaflet() %>%
#'   addTiles() %>%
#'   addMarkers(data = quakes,
#'              icon = icons(iconUrl = symbols),
#'              lat = ~lat, lng = ~long) %>%
#'   addLegendSize(
#'     values = quakes$depth,
#'     pal = numPal,
#'     title = 'Depth',
#'     labelStyle = 'margin: auto;',
#'     shape = c('triangle'),
#'     orientation = c('vertical', 'horizontal'),
#'     opacity = .7,
#'     breaks = 5)
#'
#' # a wrapper for making icons is provided
#' sizeSymbols <-
#' makeSymbolsSize(
#'   quakes$depth,
#'   shape = 'cross',
#'   fillColor = numPal(quakes$depth),
#'   color = 'black',
#'   strokeWidth = 1,
#'   opacity = .8,
#'   fillOpacity = .5,
#'   baseSize = 20
#' )
#' leaflet() %>%
#'   addTiles() %>%
#'   addMarkers(data = quakes,
#'              icon = sizeSymbols,
#'              lat = ~lat, lng = ~long) %>%
#'   addLegendSize(
#'     values = quakes$depth,
#'     pal = numPal,
#'     title = 'Depth',
#'     shape = 'cross',
#'     orientation = 'horizontal',
#'     strokeWidth = 1,
#'     opacity = .8,
#'     fillOpacity = .5,
#'     color = 'black',
#'     baseSize = 20,
#'     breaks = 5)
#'
#' # Group layers control
#' leaflet() %>%
#'   addTiles() %>%
#'     addLegendSize(
#'       values = quakes$depth,
#'       pal = numPal,
#'       title = 'Depth',
#'       labelStyle = 'margin: auto;',
#'       shape = c('triangle'),
#'       orientation = c('vertical', 'horizontal'),
#'       opacity = .7,
#'       breaks = 5,
#'       group = 'Depth') %>%
#'     addLayersControl(overlayGroups = c('Depth'))
#'
#' # Polyline Legend for Size
#' baseSize <- 10
#' lineColor <- '#00000080'
#' pal <- colorNumeric('Reds', atlStorms2005$MinPress)
#' leaflet() %>%
#'   addTiles() %>%
#'   addPolylines(data = atlStorms2005,
#'                weight = ~sizeNumeric(values = MaxWind, baseSize = baseSize),
#'                color = ~pal(MinPress),
#'                popup = ~as.character(MaxWind)) %>%
#'   addLegendLine(values = atlStorms2005$MaxWind,
#'                 title = 'MaxWind',
#'                 baseSize = baseSize,
#'                 width = 50,
#'                 color = lineColor) %>%
#'   addLegendNumeric(pal = pal,
#'                    title = 'MinPress',
#'                    values = atlStorms2005$MinPress)
#'
#' # Stacked Legends
#' leaflet(quakes) %>%
#' addTiles() %>%
#'   addSymbolsSize(values = ~10^(mag),
#'     lat = ~lat,
#'     lng = ~long,
#'     shape = 'circle',
#'     color = 'black',
#'     fillColor = 'red',
#'     opacity = 1,
#'     baseSize = 5) %>%
#'   addLegendSize(
#'     values = ~10^(mag),
#'     title = 'Magnitude',
#'     baseSize = 5,
#'     shape = 'circle',
#'     color = 'black',
#'     fillColor = 'red',
#'     labelStyle = 'font-size: 18px;',
#'     position = 'bottomleft',
#'     stacked = TRUE,
#'     breaks = 5)
#'     # dashed lines
#' leaflet() %>%
#'    addTiles() %>%
#'    addLegendSymbol(color='black', dashArray = list("none", "24"),
#'      shape = c("line", "line"), values = c('solid', 'dashed'),
#'      strokeWidth = 10, height = 20, width = 100)
#'
#' #advanced shape customization, aesthetic arguments are propogated if
#' # vectors are equal length or of size 1
#' defaultShapes <- availableShapes()[["default"]]
#' leaflet() %>%
#'   addTiles() %>%
#'   addLegendSymbol(
#'     shape = defaultShapes,
#'     color = "black",
#'     fillColor =
#'       colorRampPalette(c("blue",  "yellow"))(length(defaultShapes)),
#'     width = seq(1L, length(defaultShapes), 1L) * length(defaultShapes),
#'     values = factor(defaultShapes, defaultShapes),
#'     strokeWidth = 2
#'   )
#'
#' # label centered inside each legend symbol
#' leaflet() %>%
#'   addTiles() %>%
#'   addLegendSymbol(
#'     shape = c('circle', 'circle', 'circle'),
#'     color = 'black',
#'     fillColor = c('red', 'blue', 'green'),
#'     fillOpacity = 0.8,
#'     values = c('A', 'B', 'C'),
#'     label = c('A', 'B', 'C'),
#'     width = 24
#'   )
addLegendSize <- function(map,
                          pal,
                          values,
                          title = NULL,
                          labelStyle = 'vertical-align: middle;',
                          shape = 'rect',
                          orientation = c('vertical', 'horizontal'),
                          color,
                          fillColor = color,
                          strokeWidth = 1,
                          opacity = 1,
                          fillOpacity = opacity,
                          breaks = 5,
                          baseSize = 20,
                          minSize = NULL,
                          maxSize = NULL,
                          numberFormat = function(x) {
                            prettyNum(x, big.mark = ',', scientific = FALSE,
                                      digits = 1)
                            },
                          group = NULL,
                          className = 'info legend leaflet-control',
                          stacked = FALSE,
                          data = leaflet::getMapData(map),
                          ...) {
  values <- parseValues(values = values, data = data)
  sizes <- sizeBreaks(values, breaks, baseSize, minSize = minSize, maxSize = maxSize)
  if ( missing(color) ) {
    stopifnot( missing(color) & !missing(pal))
    colors <- pal(as.numeric(names(sizes)))
  } else {
    stopifnot(length(color) == 1 || length(color) == length(breaks))
    colors <- color
  }
  if ( missing(fillColor) ) {
    if ( !missing(pal) ) {
      fillColors <- pal(as.numeric(names(sizes)))
    } else {
      fillColors <- colors
    }
  } else {
    stopifnot(length(fillColor) == 1 || length(fillColor) == length(breaks))
    fillColors <- fillColor
  }
  labels <- numberFormat(as.numeric(names(sizes)))
  if (length(names(breaks)) == length(breaks) && length(breaks) > 1) {
    labels <- names(breaks)
  }
  symbols <- Map(makeSymbol,
                 shape = shape,
                 width = sizes,
                 height = sizes,
                 color = colors,
                 fillColor = fillColors,
                 opacity = opacity,
                 fillOpacity = fillOpacity,
                 `stroke-width` = strokeWidth)
  if (isTRUE(stacked)) {
    stackedMax <- max(sizes)
    svgElements <- rev(Map(makeSymbolElement,
      shape = shape,
      width = sizes,
      height = sizes,
      color = colors,
      fillColor = fillColors,
      opacity = opacity,
      fillOpacity = fillOpacity,
      `stroke-width` = strokeWidth,
      transform = sprintf('translate(%.02f,%.02f)', stackedMax / 2 - sizes / 2,
        stackedMax - sizes)))
    ticks <- makeTicks(breaks = sizes - strokeWidth,
      width = stackedMax / 2 + strokeWidth, height = stackedMax,
      orientation = 'vertical', strokeWidth = strokeWidth,
      `stroke-linecap` = 'square', stroke = 'black',
      transform = sprintf('translate(%.03f,0)',
        stackedMax / 2 + strokeWidth * 3 / 2))
    tickText <- makeTickText(labels = labels, breaks = sizes - strokeWidth,
      width = stackedMax, height = stackedMax, orientation = 'vertical')
    htmlElements <- assembleLegendWithTicks(width = stackedMax + strokeWidth * 2,
      height = stackedMax + strokeWidth * 2, svgElements = svgElements,
      ticks = ticks, tickText = tickText, labelStyle = labelStyle,
      marginRight = .5 * max(nchar(labels)),
      marginBottom = 0)
    htmlElements <- htmltools::tagList(title, htmlElements = htmlElements)
    leaflegendAddControl(map, html = htmltools::tagList(htmlElements),
      className = className, group = group, ...)
  } else {
    addLegendImage(map, images = symbols,
                   labels = labels,
                   title = title, labelStyle = labelStyle,
                   orientation = orientation, width = sizes, height = sizes,
                   group = group, className = className, ...)
  }

}

#' @param minSize
#'
#' minimum size in pixels of a symbol; values that would scale below this are
#' clamped to \code{minSize}; \code{baseSize} must be greater than \code{minSize}
#'
#' @param maxSize
#'
#' maximum size in pixels of a symbol; values that would scale above this are
#' clamped to \code{maxSize}; \code{baseSize} must be less than \code{maxSize}
#'
#' @param centerPoint
#'
#' the value used as the center of the scaling; defaults to the mean of
#' \code{values}; the symbol for \code{centerPoint} will be exactly
#' \code{baseSize} pixels
#'
#' @export
#'
#' @rdname mapSymbols
sizeNumeric <- function(values, baseSize, minSize = NULL, maxSize = NULL,
  centerPoint = mean(values, na.rm = TRUE)) {
  stopifnot(baseSize > 0)
  if ( !is.null(minSize) ) {
    stopifnot(minSize > 0)
    stopifnot(baseSize > minSize)
  }
  if ( !is.null(maxSize) ) {
    stopifnot(maxSize > 0)
    stopifnot(baseSize < maxSize)
  }
  if ( !is.null(minSize) && !is.null(maxSize) ) {
    stopifnot(minSize < maxSize)
  }
  sizes <- values / centerPoint * baseSize
  if ( !is.null(minSize) ) {
    sizes <- pmax(sizes, minSize)
  }
  if ( !is.null(maxSize) ) {
    sizes <- pmin(sizes, maxSize)
  }
  sizes
}

#' @param breaks
#'
#' an integer specifying the number of breaks or a numeric vector of the breaks;
#' if a named vector then the names are used as labels.
#'
#' @param baseSize
#'
#' re-scaling size in pixels of the mean of the values, the average value will
#' be this exact size
#'
#' @param ...
#'
#' arguments to pass to \code{pretty}
#'
#' @export
#'
#' @rdname mapSymbols
sizeBreaks <- function(values, breaks, baseSize, minSize = NULL, maxSize = NULL, 
  ...) {
  stopifnot(baseSize > 0)
  if ( length(breaks) == 1 ) {
    breaks <- pretty(values, breaks, ...)
  }
  sizes <- sizeNumeric(values = breaks, baseSize = baseSize, minSize = minSize,
    maxSize = maxSize, centerPoint = mean(values, na.rm = TRUE))
  stats::setNames(sizes, breaks)[breaks > 0 & breaks <= max(values)]
}

#' @export
#'
#' @rdname mapSymbols
makeSymbolsSize <- function(values,
                          shape = 'rect',
                          color,
                          fillColor,
                          opacity = 1,
                          fillOpacity = opacity,
                          strokeWidth = 1,
                          baseSize,
                          minSize = NULL,
                          maxSize = NULL,
                          ...
                          ) {
  stopifnot(strokeWidth >= 0)
  stopifnot(length(color) == 1 || length(color) == length(values))
  stopifnot(length(fillColor) == 1 || length(fillColor) == length(values))
  stopifnot(length(shape) < 2)
  sizes <- sizeNumeric(values, baseSize, minSize = minSize, maxSize = maxSize)
  makeSymbolIcons(
    shape = shape,
    width = sizes,
    height = sizes,
    color = color,
    fillColor = fillColor,
    opacity = opacity,
    fillOpacity = fillOpacity,
    strokeWidth = strokeWidth,
    ...
  )
}
#' @param width
#'
#' width in pixels of the lines
#'
#' @export
#'
#' @rdname legendSymbols
addLegendLine <- function(map,
                          pal,
                          values,
                          title = NULL,
                          labelStyle = 'vertical-align: middle;',
                          orientation = c('vertical', 'horizontal'),
                          width = 20,
                          color,
                          opacity = 1,
                          fillOpacity = opacity,
                          breaks = 5,
                          baseSize = 10,
                          minSize = NULL,
                          maxSize = NULL,
                          numberFormat = function(x) {
                            prettyNum(x, big.mark = ',', scientific = FALSE,
                                      digits = 1)
                            },
                          group = NULL,
                          className = 'info legend leaflet-control',
                          data = leaflet::getMapData(map),
                          ...) {
  shape <- 'rect'
  values <- parseValues(values = values, data = data)
  sizes <- sizeBreaks(values, breaks, baseSize, minSize = minSize, 
    maxSize = maxSize)
  if ( missing(color) ) {
    stopifnot( missing(color) & !missing(pal))
    colors <- pal(as.numeric(names(sizes)))
  } else {
    stopifnot(length(color) == 1 || length(color) == length(breaks))
    colors <- color
  }
  labels <- numberFormat(as.numeric(names(sizes)))
  if (length(names(breaks)) == length(breaks) && length(breaks) > 1) {
    labels <- names(breaks)
  }
  symbols <- Map(makeSymbol,
                 shape = shape,
                 width = width,
                 height = sizes,
                 color = 'transparent',
                 fillColor = colors,
                 opacity = opacity,
                 fillOpacity = fillOpacity,
                 `stroke-width` = 0)
  addLegendImage(map, images = symbols,
                 labels = labels,
                 title = title, labelStyle = labelStyle,
                 orientation = orientation, width = width, height = sizes,
                 group = group, className = className, ...)

}

#' @param height
#'
#' in pixels
#'
#' @param dashArray
#'
#' a string or vector/list of strings that defines the stroke dash pattern
#'
#' @param label
#'
#' a character vector of labels to display at the center of each symbol
#'
#' @export
#'
#' @rdname legendSymbols
addLegendSymbol <- function(map,
                            pal,
                            values,
                            title = NULL,
                            labelStyle = 'vertical-align: middle;',
                            shape,
                            orientation = c('vertical', 'horizontal'),
                            color,
                            fillColor = color,
                            strokeWidth = 1,
                            opacity = 1,
                            fillOpacity = opacity,
                            width = 20,
                            height = width,
                            group = NULL,
                            className = 'info legend leaflet-control',
                            dashArray = NULL,
                            label = NULL,
                            data = leaflet::getMapData(map),
                            ...
) {
  if (missing(shape)) {
    shape <- availableShapes()[['default']]
  }
  values <- sort(unique(as.factor(parseValues(values, data))))
  if ( length(levels(values)) > length(shape) ) {
    stop('values has more factor levels than shape. Maximum levels is 7')
  }
  shape <- shape[values]
  if ( missing(color) ) {
    stopifnot( missing(color) & !missing(pal))
    colors <- pal(values)
  } else {
    stopifnot(length(color) == 1 || length(color) == length(values))
    colors <- color
  }
  if ( missing(fillColor) ) {
    if ( !missing(pal) ) {
      fillColors <- pal(values)
    } else {
      fillColors <- colors
    }
  } else {
    stopifnot(length(fillColor) == 1 || length(fillColor) == length(values))
    fillColors <- fillColor
  }
  if (is.null(dashArray)) {
    dashArray <- 'none'
  }
  label <- parseValues(label, data)
  args <- list(makeSymbol,
               shape = shape,
               width = width,
               height = height,
               color = colors,
               fillColor = fillColors,
               opacity = opacity,
               fillOpacity = fillOpacity,
               `stroke-width` = strokeWidth,
               `stroke-dasharray` = dashArray)
  if (!is.null(label)) {
    args <- append(args, list(label = label))
  }
  symbols <- do.call(Map, args)
  addLegendImage(map, images = symbols,
                 labels = as.character(values),
                 title = title, labelStyle = labelStyle,
                 orientation = orientation, width = width, height = height,
                 group = group, className = className, ...)
}

#' Add a legend with Awesome Icons
#'
#' @param map
#'
#' a map widget object created from 'leaflet'
#'
#' @param iconSet
#'
#' a named list from \link[leaflet]{awesomeIconList}, the names will be the
#' labels in the legend
#'
#' @param title
#'
#' the legend title, pass in HTML to style
#'
#' @param labelStyle
#'
#' character string of style argument for HTML text
#'
#' @param marker
#'
#' whether to show the marker or only the icon
#'
#' @param orientation
#'
#' stack the legend items vertically or horizontally
#'
#' @param group
#'
#' group name of a leaflet layer group
#'
#' @param className
#'
#' extra CSS class to append to the control, space separated
#'
#' @param ...
#'
#' arguments to pass to \link[leaflet]{addControl}
#'
#' @return
#'
#' an object from \link[leaflet]{addControl}
#'
#' @export
#'
#' @examples
#' library(leaflet)
#' data(quakes)
#' iconSet <- awesomeIconList(
#'   `Font Awesome` = makeAwesomeIcon(icon = "font-awesome", library = "fa",
#'                                    iconColor = 'gold', markerColor = 'red',
#'                                    spin = FALSE,
#'                                    squareMarker = TRUE,
#'                                    iconRotate = 30,
#'   ),
#'   Ionic = makeAwesomeIcon(icon = "ionic", library = "ion",
#'                           iconColor = '#ffffff', markerColor = 'blue',
#'                           spin = TRUE,
#'                           squareMarker = FALSE),
#'   Glyphicon = makeAwesomeIcon(icon = "plus-sign", library = "glyphicon",
#'                               iconColor = 'rgb(192, 255, 0)',
#'                               markerColor = 'darkpurple',
#'                               spin = TRUE,
#'                               squareMarker = FALSE)
#' )
#' leaflet(quakes[1:3,]) %>%
#'   addTiles() %>%
#'   addAwesomeMarkers(lat = ~lat,
#'                     lng = ~long,
#'                     icon = iconSet) %>%
#'   addLegendAwesomeIcon(iconSet = iconSet,
#'                        orientation = 'horizontal',
#'                        title = htmltools::tags$div(
#'                          style = 'font-size: 20px;',
#'                          'Awesome Icons'),
#'                        labelStyle = 'font-size: 16px;') %>%
#'   addLegendAwesomeIcon(iconSet = iconSet,
#'                        orientation = 'vertical',
#'                        marker = FALSE,
#'                        title = htmltools::tags$div(
#'                          style = 'font-size: 20px;',
#'                          'Awesome Icons'),
#'                        labelStyle = 'font-size: 16px;')
addLegendAwesomeIcon <- function(map,
                                 iconSet,
                                 title = NULL,
                                 labelStyle = 'vertical-align: middle;',
                                 orientation = c('vertical', 'horizontal'),
                                 marker = TRUE,
                                 group = NULL,
                                 className = 'info legend leaflet-control',
                                 ...) {
  stopifnot(inherits(iconSet, 'leaflet_awesome_icon_set'))
  stopifnot( !is.null(names(iconSet)) &&
               length(names(iconSet)) == length(iconSet) )
  orientation <- match.arg(orientation)
  if ( orientation == 'vertical' ) {
    wrapElements <- htmltools::tags$div
  } else {
    wrapElements <- htmltools::tags$span
  }
  currentDepNames <- vapply(map$dependencies, getElement, name = 'name',
                            FUN.VALUE = 'character')
  iconLibraries <- unique(vapply(iconSet, getElement, name = 'library',
                                 FUN.VALUE = character(1)))
  verifyIconLibrary(iconLibraries)
  iconLibraries <- c(
    fa = 'fontawesome',
    ion = 'ionicons',
    glyphicon = 'bootstrap')[iconLibraries]
  missingDeps <- setdiff(c('leaflet-awesomemarkers', iconLibraries),
                         currentDepNames)
  iconDeps <- c(
    `leaflet-awesomemarkers` = leafletAwesomeMarkersDependencies(),
    fontawesome = leafletAmFontAwesomeDependencies(),
    ion = leafletAmIonIconDependencies(),
    bootstrap = leafletAmBootstrapDependencies())[missingDeps]
  map$dependencies <- c(map$dependencies, unname(iconDeps))
  htmlElements <-
    Map(icon = iconSet,
        label = names(iconSet),
        f = function(icon, label) {
          markerClass <- ''
          if ( marker ) {
            markerClass <- sprintf(
              'awesome-marker-icon-%s awesome-marker %s',
              icon[['markerColor']],
              ifelse(icon[['squareMarker']], 'awesome-marker-square', ''))
          }
      htmltools::tagList(
        wrapElements(
        htmltools::tags$div(
          style = 'vertical-align: middle; display:
          inline-block; position: relative;',
              class = markerClass,
              htmltools::tags$i(class = sprintf('%1$s %1$s-%2$s %3$s',
                                                icon[['library']],
                                                icon[['icon']],
                                                ifelse(icon[['spin']], 'fa-spin', '')),
                                style = sprintf('color: %s; %s; margin-right: 0px', icon[['iconColor']],
                                                ifelse(icon[['iconRotate']] == 0, '',
                                                       sprintf('-webkit-transform: rotate(%1$sdeg);-moz-transform: rotate(%1$sdeg);-o-transform: rotate(%1$sdeg);-ms-transform: rotate(%1$sdeg);transform: rotate(%1$sdeg);',
                                                               icon[['iconRotate']]))
                                ),
                                if ( !is.null(icon[['text']]) ) {
                                  icon[['text']]
                                  }
              )
        ),
        htmltools::tags$span(label, style = sprintf('%s', labelStyle))
      )
      )
    })
  htmlElements <- addTitle(title = title, htmlElements = htmlElements)
  leaflegendAddControl(map, html = htmltools::tagList(htmlElements),
                       className = className, group = group, ...)
}

leaflegendAddControl <- function(map,
                                 html,
                                 className,
                                 group,
                                 ...) {

  if ( !is.null(group) ) {
    leafLegendClassName <- paste('leaflegend-group', gsub('\\W|_', '', group),
                                 sep = '-')
    className <- paste(className, leafLegendClassName)

    lf <- leaflet::addControl(map, html = html, className = className, ...)
    htmlwidgets::onRender(lf, "
function(el, x) {
  var updateLeafLegend = function() {
    var controlGroups = el.querySelectorAll(
      'input.leaflet-control-layers-selector');
    controlGroups.forEach(g => {
      var groupName = g.nextSibling.innerText.substr(1);
      var className = 'leaflegend-group-' +
        groupName.replace(/[^a-zA-Z0-9]/g, '');
      var checked = g.checked;
      el.querySelectorAll('.legend.' + className).forEach(l => {
        l.hidden = !checked;
      })
    })
  }

  updateLeafLegend();
  this.on('baselayerchange', el => updateLeafLegend())
  this.on('overlayadd', el => updateLeafLegend());
  this.on('overlayremove', el => updateLeafLegend());
}
                        ")
  } else {
    leaflet::addControl(map, html = html, className = className, ...)
  }
}

parseValues <- function(values, data) {
  if ( inherits(values, 'formula') ) {
    stopifnot(!is.null(data))
    leaflet::evalFormula(values, data)
  } else {
    values
  }
}

#' Available shapes for map symbols
#'
#' @return
#'
#' list of available shapes
#'
#' @export
#'
availableShapes <- function() {
  list(
    'default' =
      c('rect', 'circle', 'triangle', 'plus', 'cross', 'diamond', 'star',
        'stadium', 'line', 'polygon'),
    'pch' =
      c('open-rect', 'open-circle', 'open-triangle', 'simple-plus',
        'simple-cross', 'open-diamond', 'open-down-triangle', 'cross-rect',
        'simple-star', 'plus-diamond', 'plus-circle', 'hexagram', 'plus-rect',
        'cross-circle', 'triangle-rect', 'solid-rect', 'solid-circle-md',
        'solid-triangle', 'solid-diamond', 'solid-circle-bg', 'solid-circle-sm',
        'circle', 'rect', 'diamond', 'triangle', 'down-triangle'
      ),
    'special' = c('text')
  )
}

# Borrowed from "leaflet" package internal functions
leafletAmBootstrapDependencies <- function() {
  list(htmltools::htmlDependency(
    "bootstrap", "3.3.7", "htmlwidgets/plugins/Leaflet.awesome-markers",
    package = "leaflet", script = c("bootstrap.min.js"),
    stylesheet = c("bootstrap.min.css")))
}
leafletAmFontAwesomeDependencies <- function() {
  list(htmltools::htmlDependency(
    "fontawesome", "4.7.0", "htmlwidgets/plugins/Leaflet.awesome-markers",
    package = "leaflet", stylesheet = c("font-awesome.min.css")))
}
leafletAmIonIconDependencies <- function() {
  list(htmltools::htmlDependency(
    "ionicons", "2.0.1", "htmlwidgets/plugins/Leaflet.awesome-markers",
    package = "leaflet", stylesheet = c("ionicons.min.css")))
}
leafletAwesomeMarkersDependencies <- function() {
  list(htmltools::htmlDependency(
    "leaflet-awesomemarkers",
    "2.0.3", "htmlwidgets/plugins/Leaflet.awesome-markers",
    package = "leaflet", script = c("leaflet.awesome-markers.min.js"),
    stylesheet = c("leaflet.awesome-markers.css")))

}
verifyIconLibrary <- function(library) {
  bad <- library[!(library %in% c("glyphicon", "fa", "ion"))]
  if (length(bad) > 0) {
    stop("Invalid icon library names: ", paste(unique(bad), collapse = ", "))
  }
}
