R/palette_coolors.R

In simmwill/coolors: Generate palettes from coolors.co

#' Coolors palette generator
#'
#' Use \code{\link{palette_coolors}} to construct palettes of desired length
#'
#' @param palette_num integer; arbitrary palette identifier. Randomly generated by default, or can be specifically chosen from
#'   existing Coolors palettes using an integer between 1 and 2092.
#' @param n integer; desired length of palette. Default length 5. Lengths greater than 5 will use color interpolation to
#'   create palette from original 5-color palette.
#' @param hex logical; TRUE provides a character vector of hex codes.
#' @param hist logical; indicates whether an object storing palette history is created/updated for the current session. Since this
#'   function's default color generation scheme is random, this  allows the user to review recently-generated palettes via their
#'   identifiers, stored in a list. The most recent palette will be list item 1, the second-most recent list item 2, etc.
#'
#' @return A vector of colors.
#' @export
#'
#' @examples
#' # generate random palette
#' palette_coolors()
#'
#' # random palette of length 10
#' palette_coolors(n = 10)
#'
#' # if you liked a specific palette, specify its identifier
#' palette_coolors(palette_num = 1234, n = 20)
#'

palette_coolors <- function(palette_num, n, hex = FALSE, hist = TRUE) {

  if(missing(palette_num)) palette_num <- sample(seq_along(coolors), 1)

  if (palette_num > length(coolors)) {
    stop(paste0("Please choose a palette number between 1 and ", length(coolors), "."))
  }

  pal <- coolors[[palette_num]]
  if (is.null(pal))
    stop("Palette not found.")

  if (missing(n)) {
    n <- length(pal)
  }

  type <- ifelse(n > length(pal), "continuous", "discrete")

  out <- switch(type,
                continuous = grDevices::colorRampPalette(pal)(n),
                discrete = pal[1:n]
  )

  if(hist) {

    coolors_hist <- purrr::prepend(lapply(coolors_get(coolors_hist), unname), list(palette_num))
    names(coolors_hist) <- NULL
    names(coolors_hist[[1]]) <- "Most recent: "
    coolors_set(coolors_hist)

  }

  if(hex){
    message(paste0("Coolors palette ", palette_num))
    out
  } else {
    structure(out, class = "palette", name = paste("Coolors palette", palette_num))
  }

}

#' @export
#' @importFrom graphics rect par image text
print.palette <- function(x, ...) {

  n <- length(x)
  old <- par(mar = c(0.5, 0.5, 0.5, 0.5))
  on.exit(par(old))

  image(1:n, 1, as.matrix(1:n), col = x, ylab = "", xaxt = "n", yaxt = "n", bty = "n")

  rect(0, 0.9, n + 1, 1.1, col = grDevices::rgb(1, 1, 1, 0.5), border = NA)
  text((n + 1) / 2, 1, labels = attr(x, "name"), cex = 0.9, family = "mono")

  invisible(x)

}