R/set-alpha.R

In houyunhuang/tinycolor: Parse and Manipulate Colors with tinycolor.js

#' Set color's transparcy
#'
#' Set the transparent of a color vector.
#'
#' @param x a any type color string or a javascript color object specifying.
#' @param alpha transparency, number in [0, 1]; 0 means fully transparent, 1 means fully opaque.
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#'
#' @return Returns the modified color vector.
#' @export
#' @examples
#' set_alpha("{ r: 1, g: 0, b: 0 }", alpha = 0.2)
#' set_alpha("{ h: 0.5, s: 0.5, v: 0.5 }", alpha = 0.5)
#' set_alpha("red", alpha = 0.6)
#' set_alpha("#F12", alpha = 0.7)
set_alpha <- function(x, alpha = NA, na.rm = FALSE) {
  alpha <- ifelse(is.na(alpha), 1, alpha)
  if(length(x) < length(alpha))
    stop("The length of `alpha` must be shorter or equal `x`.", call. = FALSE)
  if(length(x) > length(alpha)) alpha <- rep_len(alpha, length(x))
  rng <- range(alpha, na.rm = TRUE)
  if(!(rng[2] <= 1 && rng[1] >= 0))
    stop("`alpha` should be in range 0 to 1 or NA.", call. = FALSE)
  if(na.rm) x <- x[! is.na(x)]
  if(all(is.na(x))) return(NA_character_)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor(", x, ").setAlpha(", alpha, ")"),
                paste0("tinycolor(\"", x, "\").setAlpha(", alpha, ")"))
  out <- ifelse(is_valid_color(x), v8_eval(cmd), NA)
  return(out)
}