R/create_palfun.R

In seb09/cccolr: Implementation of Chrestos colors

#' Create palette function
#' 
#' Create a palette function from the implemented color palettes (or a list of custom palettes).
#' 
#' @param palette Name of the color palette (character). Use \code{names(chrestos_palettes())} to obtain the
#' names of the implemented color palettes.
#' @param reverse Use the selected palette in original or reversed order.
#' @param customPalettes If desired, a named list of custom palettes with the same structure than \code{chrestos_palettes()}.
#' @param shade Numeric vector in [0,1] that defines the brightness of the palettes. Values higher
#' than 0.5 lead to brighter colors than the original shade, values lower than 0.5 lead to darker colors.
#' @param ... Additional arguments for \code{colorRampPalette()}
#' 
#' @return A color palette function that returns \code{n} colors from the selected palette.
#' 
#' @export
#' 

create_palfun <- function(palette = "main", reverse = FALSE, customPalettes = NULL, shade = 0.5, ...){
  if (is.null(customPalettes)){
    pal <- chrestos_palettes()[[palette]]
  } else {
    pal <- customPalettes[[palette]]
  }
  pal <- sapply(pal, function(x)  grDevices::rgb(grDevices::colorRamp(c("#000000", x, "#FFFFFF"))(shade), maxColorValue = 255))
  if (reverse) pal <- rev(pal)
  fun <- function(n){
    if (n<length(pal)){
      grDevices::colorRampPalette(pal[1:n], ...)(n)
    } else {
      grDevices::colorRampPalette(pal, ...)(n)
    }
  }
  return(fun)
}