R/hex2pal.R

In shk5660/img2pal: Convert Images to Palettes & Sample Palettes

hex2pal <- function (hex, n, type = c("discrete", "continuous")) {
  type <- match.arg(type)
  pal <- hex
  if (is.null(pal))
    stop("Palette not found.")
  if (missing(n)) {
    n <- length(pal)
  }
  if (type == "discrete" && n > length(pal)) {
    stop("Number of requested colors greater than what palette can offer")
  }
  out <- switch(type, continuous = colorRampPalette(pal)(n),
                discrete = pal[1:n])
  structure(out, class = "palette", name = deparse(substitute(hex)))
}


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 = rgb(1, 1, 1, 0.8), border = NA)
  text((n + 1) / 2, 1, labels = attr(x, "name"), cex = 3, family = "serif")
}