R/color-modification.R

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

#' Manipulate the color
#'
#' Function of manipulate the color's lightness, brightness, darkness, desaturate, saturate.
#'
#' @param x a any type color string or a javascript color object specifying.
#' @param method The methods will manipulate.
#' @param amount Amount of manipulate the color, from 0 to 100.
#' @param tohex8 convert the return value to 8-bit hex color.
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#'
#' @details
#'  `col_lighten` lighten the color a given amount, from 0 to 100. Providing 100 will always return white.
#'  `col_brighten` brighten the color a given amount, from 0 to 100.
#'  `col_darken` darken the color a given amount, from 0 to 100. Providing 100 will always return black.
#'  `col_saturate` desaturate the color a given amount, from 0 to 100. Providing 100 will is the same as calling greyscale.
#'  `col_desaturate` saturate the color a given amount, from 0 to 100.
#'  `col_grey` completely desaturates a color into greyscale. Same as calling desaturate(100).
#'  `col_spin` spin the hue a given amount, from -360 to 360. Calling with 0, 360, or -360 will do nothing (since it sets the hue back to what it was before).
#'
#' @return Returns the modified color vector.
#' @export
#' @examples
#' col_lighten("red")
#' col_brighten("green", amount = 40)
#' col_darken("blue", amount = 30)
#' col_saturate("hsl(0, 10%, 50%)")
#' col_desaturate("hsl(0, 40%, 50%)")
#' col_grey("red")
#' hue_spin("#F00", amount = 90)

manipulate_col <- function(x, methods, amount, tohex8) {
  type <- match.arg(methods, c("lighten", "brighten", "darken", "desaturate", "saturate"))
  if(length(amount) > length(x))
    stop("Length of `x` must be greater than length of `amount`")
  if(length(amount) < length(x)) amount <- rep_len(amount, length(x))
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ").", methods, "(amount = ", amount, ")"),
                paste0("tinycolor", "(\"", x, "\").", methods, "(amount = ", amount, ")"))
  if(tohex8)
    cmd <- ifelse(is.na(cmd), NA, paste0(cmd, ".toHex8String()"))
  out <- v8_eval(cmd)
  return(out)
}
#' @rdname manipulate_col
#' @export
col_lighten <- function(x, amount = 10, tohex8 = TRUE, na.rm = FALSE) {
  if(na.rm) x <- x[!is.na(x)]
  out <- manipulate_col(x, methods = "lighten", amount = amount, tohex8 = tohex8)
  return(out)
}
#' @rdname manipulate_col
#' @export
col_brighten <- function(x, amount = 10, tohex8 = TRUE, na.rm = FALSE) {
  if(na.rm) x <- x[!is.na(x)]
  out <- manipulate_col(x, methods = "brighten", amount = amount, tohex8 = tohex8)
  return(out)
}
#' @rdname manipulate_col
#' @export
col_darken <- function(x, amount = 10, tohex8 = TRUE, na.rm = FALSE) {
  if(na.rm) x <- x[!is.na(x)]
  out <- manipulate_col(x, methods = "darken", amount = amount, tohex8 = tohex8)
  return(out)
}
#' @rdname manipulate_col
#' @export
col_desaturate <- function(x, amount = 10, tohex8 = TRUE, na.rm = FALSE) {
  if(na.rm) x <- x[!is.na(x)]
  out <- manipulate_col(x, methods = "desaturate", amount = amount, tohex8 = tohex8)
  return(out)
}
#' @rdname manipulate_col
#' @export
col_saturate <- function(x, amount = 10, tohex8 = TRUE, na.rm = FALSE) {
  if(na.rm) x <- x[!is.na(x)]
  out <- manipulate_col(x, methods = "saturate", amount = amount, tohex8 = tohex8)
  return(out)
}

#' @rdname manipulate_col
#' @export
col_grey <- function(x, tohex8 = FALSE, na.rm = FALSE) {
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ")", ".greyscale()"),
                paste0("tinycolor", "(\"", x, "\")", ".greyscale()"))
  if(tohex8)
    cmd <- ifelse(is.na(cmd), NA, paste0(cmd, ".toHex8String()"))
  out <- v8_eval(cmd)
  return(out)
}

#' Spin the hue
#'
#' Spin the hue a given amount.
#'
#' @param x a tinycolor color string specifying.
#' @param amount Amount of manipulate the color, from -360 to 360.
#' @param tohex8 convert the return value to 8-bit hex color.
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#'
#' @return Returns the modified color vector.
#' @export
hue_spin <- function(x, amount = 0, tohex8 = FALSE, na.rm = FALSE) {
  if(length(amount) > length(x))
    stop("Length of `x` must be greater than length of `amount`")
  if(length(amount) < length(x)) amount <- rep_len(amount, length(x))
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ")", ".spin(amount = ", amount, ")"),
                paste0("tinycolor", "(\"", x, "\")", ".spin(amount = ", amount, ")"))
  if(tohex8)
    cmd <- ifelse(is.na(cmd), NA, paste0(cmd, ".toHex8String()"))
  out <- v8_eval(cmd)
  return(out)
}