R/color-combination.R

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

#' Combinate the color
#'
#' Function of combinating the color.
#'
#' @param x a any type color string or a javascript color object specifying.
#' @param results The number of return value.
#' @param slices The number of slices.
#' @param simplify If FALSE, the default, returns a list of color vectors.
#' @param na.rm a logical value indicating whether NA values should be stripped before the computation proceeds.
#'
#' @return Returns the modified color list.
#' @export
#' @examples
#' col_analogous("#f00")
#' col_monochromatic("blue")
#' col_splitcomplement("red")
#' col_triad("red")
#' col_tetrad("red")
#' col_complement("#f12")

col_analogous <- function(x, results = 6, slices = 30, simplify = FALSE, na.rm = FALSE) {

  if(length(results) > length(x) || length(slices) > length(x))
    stop("Length of `x` must be greater than length of `results` and `slices`")
  if(length(results) < length(x)) results <- rep_len(results, length(x))
  if(length(slices) < length(x)) slices <- rep_len(slices, length(x))
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ")", ".analogous(results = ", results, ",slices = ", slices,")"),
                paste0("tinycolor", "(\"", x, "\")", ".analogous(results = ", results, ",slices = ", slices,")"))
  o <- parse_color(cmd)
  out <- stringr::str_split(o, ',', simplify = simplify)
  return(out)
}

#' @rdname col_analogous
#' @export
col_monochromatic <- function(x, results = 6, slices = 30, simplify = FALSE, na.rm = FALSE) {

  if(length(results) > length(x) || length(slices) > length(x))
    stop("Length of `x` must be greater than length of `results` and `slices`")
  if(length(results) < length(x)) results <- rep_len(results, length(x))
  if(length(slices) < length(x)) slices <- rep_len(slices, length(x))
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ")", ".monochromatic(results = ", results, ",slices = ", slices,")"),
                paste0("tinycolor", "(\"", x, "\")", ".monochromatic(results = ", results, ",slices = ", slices,")"))
  o <- parse_color(cmd)
  out <- stringr::str_split(o, ',', simplify = simplify)
  return(out)
}

#' @rdname col_analogous
#' @export
col_splitcomplement <- function(x, simplify = FALSE, na.rm = FALSE) {
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ")", ".splitcomplement()"),
                paste0("tinycolor", "(\"", x, "\")", ".splitcomplement()"))
  o <- parse_color(cmd)
  out <- stringr::str_split(o, ',', simplify = simplify)
  return(out)
}

#' @rdname col_analogous
#' @export
col_triad <- function(x, simplify = FALSE, na.rm = FALSE) {
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ")", ".triad()"),
                paste0("tinycolor", "(\"", x, "\")", ".triad()"))
  o <- parse_color(cmd)
  out <- stringr::str_split(o, ',', simplify = simplify)
  return(out)
}

#' @rdname col_analogous
#' @export
col_tetrad <- function(x, simplify = FALSE, na.rm = FALSE) {
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ")", ".tetrad()"),
                paste0("tinycolor", "(\"", x, "\")", ".tetrad()"))
  o <- parse_color(cmd)
  out <- stringr::str_split(o, ',', simplify = simplify)
  return(out)
}

#' @rdname col_analogous
#' @export
col_complement <- function(x, simplify = FALSE, na.rm = FALSE) {
  if(!is.character(x)) x <- as.character(x)
  cmd <- ifelse(is_js_object(x),
                paste0("tinycolor", "(", x, ")", ".complement().toHexString()"),
                paste0("tinycolor", "(\"", x, "\")", ".complement().toHexString()"))
  out <- v8_eval(cmd)
  return(out)
}