Nothing
#' Generate Font Awesome icons as SVGs
#'
#' Add one or more Font Awesome icons as SVGs contained within `<svg>...</svg>`.
#' We can optionally set certain style attributes. The `fa()` function can be
#' used directly within inline evaluations of R code in R Markdown documents.
#'
#' @param name The name of the Font Awesome icon. This could be as a short name
#' (e.g., `"npm"`, `"drum"`, etc.), or, a full name (e.g., `"fab fa-npm"`,
#' `"fas fa-drum"`, etc.). The names should correspond to current Version 6
#' Font Awesome names. A list of short and full names can be accessed through
#' the [fa_metadata()] function with `fa_metadata()$icon_names` and
#' `fa_metadata()$icon_names_full`. If supplying a previous name associated
#' with the icon, it will be internally translated to the current name and a
#' Version 6 icon will be returned.
#' @param fill,fill_opacity The fill color of the icon can be set with `fill`.
#' If not provided then the default value of `"currentColor"` is applied so
#' that the SVG fill matches the color of the parent HTML element's `color`
#' attribute. The opacity level of the SVG fill can be controlled with a
#' decimal value between `0` and `1`.
#' @param stroke,stroke_width,stroke_opacity The stroke options allow for
#' setting the color, width, and opacity of the SVG outline stroke. By
#' default, the stroke width is very small at `"1px"` so a size adjustment
#' with `"stroke_width"` can be useful. The `"stroke_opacity"` value can be
#' any decimal values between `0` and `1` (bounds included).
#' @param height,width The height and width style attributes of the rendered
#' SVG. If nothing is provided for `height` then a default value of `"1em"`
#' will be applied. If a `width` isn't given, then it will be calculated in
#' units of `"em"` on the basis of the icon's SVG `"viewBox"` dimensions.
#' @param margin_left,margin_right The length value for the margin that's either
#' left or right of the icon. By default, `"auto"` is used for both
#' properties. If space is needed on either side then a length of `"0.2em"` is
#' recommended as a starting point.
#' @param vertical_align The vertical alignment of the icon. By default, a
#' length of `"-0.125em"` is used.
#' @param position The value for the `position` style attribute. By default,
#' `"relative"` is used here.
#' @param title An option for populating the SVG `'title'` attribute, which
#' provides on-hover text for the icon. By default, no title text is given to
#' the icon. If `a11y == "semantic"` then title text will be
#' automatically given to the rendered icon, however, providing text here
#' will override that.
#' @param prefer_type Chooses the type of icon returned if: (1) providing a
#' short name, and (2) that icon has both solid and regular types.
#' For example, using `name = "address-book"` will result in two types of
#' icons for an Address Book. By default, this preference is set to
#' `"regular"` and the other option is `"solid"`.
#' @param a11y Cases that distinguish the role of the icon and inform which
#' accessibility attributes to be used. Icons can either be `"deco"`
#' (decorative, the default case) or `"sem"` (semantic). Using `"none"` will
#' result in no accessibility features for the icon.
#'
#' @return A `fontawesome` object.
#'
#' @examples
#' if (interactive()) {
#'
#' # Create a Font Awesome SVG icon
#' fa(name = "r-project")
#'
#' }
#'
#' @import htmltools
#' @export
fa <- function(
name,
fill = NULL,
fill_opacity = NULL,
stroke = NULL,
stroke_width = NULL,
stroke_opacity = NULL,
height = NULL,
width = NULL,
margin_left = NULL,
margin_right = NULL,
vertical_align = NULL,
position = NULL,
title = NULL,
prefer_type = c("regular", "solid"),
a11y = c("deco", "sem", "none")
) {
prefer_type <- match.arg(prefer_type)
a11y <- match.arg(a11y)
# Ensure that the `name` value passes basic validation checks
check_name_vec(name = name)
# Get the icon index value in `fa_tbl`
idx <-
get_icon_idx(
name = name,
prefer_type = prefer_type
)
# Extract the icon width, its label, and its path
icon_width <- fa_tbl$width[idx]
icon_label <- fa_tbl$label[idx]
icon_path <- fa_tbl$path[idx]
# If both height and width are specified, don't preserve aspect ratio
svg_attrs <- ""
if (!is.null(height) && !is.null(width)) {
svg_attrs <- paste0(svg_attrs, 'preserveAspectRatio="none" ')
}
# Validate the CSS length unit on height/width (if specified),
# and return a number with the unit attached as an attribute
height_num <- parse_length_unit(height)
width_num <- parse_length_unit(width)
# Fill in height/width defaults
if (is.null(height) && is.null(width)) {
height <- "1em"
width <- paste0(round(icon_width / 512, 2), "em")
} else if (!is.null(height) && is.null(width)) {
width <-
paste0(
round((icon_width / 512) * height_num, 2),
attr(height_num, "unit")
)
} else if (is.null(height) && !is.null(width)) {
height <-
paste0(
round(width_num / (icon_width / 512), 2),
attr(width_num, "unit")
)
}
# Generate accessibility attributes if either of
# the "deco" or "sem" cases are chosen
a11y <- match.arg(a11y)
if (a11y == "deco") {
svg_attrs <- paste0(svg_attrs, 'aria-hidden="true" role="img" ')
} else if (a11y == "sem") {
title <- title %||% icon_label
svg_attrs <- paste0(
svg_attrs, sprintf('aria-label="%s" role="img" ', htmlEscape(title, attribute = TRUE))
)
}
# Generate the viewBox value through use of the only
# changing value: the width
viewbox <- c(`min-x` = 0, `min-y` = 0, width = icon_width, height = 512)
style_attr <-
paste0(
"height:", height, ";",
"width:", width, ";",
"vertical-align:", vertical_align %||% "-0.125em", ";",
"margin-left:", margin_left %||% "auto", ";",
"margin-right:", margin_right %||% "auto", ";",
"font-size:inherit;",
"fill:", fill %||% "currentColor", ";",
"overflow:visible;",
if (!is.null(fill_opacity)) paste0("fill-opacity:", fill_opacity, ";"),
if (!is.null(stroke)) paste0("stroke:", stroke, ";"),
if (!is.null(stroke_width)) paste0("stroke-width:", stroke_width, ";"),
if (!is.null(stroke_opacity)) paste0("stroke-opacity:", stroke_opacity, ";"),
"position:", position %||% "relative", ";"
)
svg_attrs <- paste0(
svg_attrs, sprintf(
'viewBox="%s" style="%s"',
paste0(viewbox, collapse = " "),
style_attr
)
)
svg <- HTML(sprintf(
'<svg %s>%s<path d="%s"/></svg>',
svg_attrs,
if (is.null(title)) "" else paste0("<title>", htmlEscape(title), "</title>"),
icon_path
))
structure(
svg, viewbox = viewbox,
size = c(h = height, w = width),
class = c("fontawesome", "svg", class(svg))
)
}
parse_length_unit <- function(css_length) {
if (is.null(css_length)) {
return(NULL)
}
if (!grepl("^^[0-9]*\\.?[0-9]+[a-z]+$", css_length)) {
stop(
"Values provided to `height` and `width` must have a numerical value ",
"followed by a length unit.",
call. = FALSE
)
}
unit <- gsub("[0-9\\.]+?", "", css_length)
if (!(unit %in% css_length_units)) {
stop(
"The provided CSS length unit is not valid.",
call. = FALSE
)
}
value <- as.numeric(gsub("[a-z]+$", "", css_length))
attr(value, "unit") <- unit
value
}
css_length_units <- c(
"cm", "mm", "in", "px", "pt", "pc", "em", "ex",
"ch", "rem", "vw", "vh", "vmin", "vmax", "%"
)
# Retrieve the row indices within fa_tbl for all rows that match the icon name
# "name", using a variety of interpretations of that name (match on fa_tbl$name,
# match on fa_tbl$full_name, or using alias_tbl to translate the name).
#
# The returned value will be an integer vector, that may be:
# * Length 0: No results found
# * Length 1: Found exactly one type
# * Length >1: This icon comes in multiple types
get_icon_idx_all_types <- function(name) {
# Attempt to match supplied `name` to short name in `fa_tbl$name`
idx <- match(name, fa_tbl$full_name)
if (!is.na(idx)) {
return(idx)
}
# An `NA` value means that no match was made so there will be
# another attempt to match against the full name in `fa_tbl$full_name`
idx <- which(fa_tbl$name == name)
if (length(idx) > 0) {
return(idx)
}
# If still no match then there will be a final attempt to match against an
# alias name in `alias_tbl$alias`; it's important to note that these alias
# names are all short names (e.g., "vcard" is an alias to the canonical name
# `address-card`);
canonical_name <- alias_tbl[alias_tbl$alias == name, "name", drop = TRUE]
if (length(canonical_name) > 0) {
idx <- which(fa_tbl$name == canonical_name)
return(idx)
}
# Nothing was found
return(integer(0))
}
get_icon_idx <- function(
name,
prefer_type,
fail_on_unknown_name = TRUE,
msg_on_unknown_name = TRUE
) {
# Get all fa_tbl indices that match--if any
idx <- get_icon_idx_all_types(name = name)
if (length(idx) == 0) {
if (!fail_on_unknown_name) {
if (msg_on_unknown_name) {
message(
"The `name` provided ('", name, "') does not correspond to a known icon"
)
}
# This is only in the case of `fa_i()` where an unmatched name
# should generate an <i> tag anyway
return(NA_integer_)
} else {
stop(
"The `name` provided ('", name, "') does not correspond to a known icon",
call. = FALSE
)
}
}
# The possible use of a short name may result in a single match in the
# `name` column of `fa_tbl`, no match at all, or multiple matches (usually
# 2, but 3 in the case of `"font-awesome"`); resolve multiple matches with
# the `prefer_type` value
if (length(idx) > 1) {
exact_match <- intersect(idx, which(fa_tbl$style == prefer_type))
if (length(exact_match) == 1) {
idx <- exact_match
} else {
# There were multiple icon types available, but not the one that was
# indicated by `prefer_type`. Just use the first one.
idx <- idx[1]
}
}
idx
}
check_name_vec <- function(name) {
if (!is.character(name)) {
stop("A character vector should be supplied for `name`.", call. = FALSE)
}
if (length(name) != 1) {
stop("The number of icons specified in `name` must be 1.", call. = FALSE)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.