R/show_color.R

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

#' Show colors
#'
#' Display one or several (collections of) colors next to each other
#'
#' @param ... vectors of colors (specified as hex codes) to display.
#' @param height height of color bar.
#' @param lspace space of left margin.
#' @param rspace space of right margin.
#' @param name a logic value indicates whether plot the color name.
#' @param name.pos name should the viewport be aligned to the top or bottom.
#' @param name.cex expansion factor for numeric axis name.
#' @param name.rot A numerical value specifying (in degrees) how name should be rotated, from 0 to 180.
#' @param name.space space betweed name and color bar.
#' @param bcol background color of plot region.
#'
#' @examples
#' show_color("red")
#' show_color(col_random(10))
#' @export
#' @importFrom grid grid.newpage viewport pushViewport upViewport stringWidth grid.rect grid.text gpar unit is.unit
show_color <- function (...,
                       height = 1,
                       lspace = 0.4,
                       rspace = 0.4,
                       name = TRUE,
                       name.pos = c("top", "bottom"),
                       name.cex = 1,
                       name.rot = 90,
                       name.space = 0.02,
                       defualt.units = "inches",
                       bcol = NA)
{
  col <- unlist(list(...), use.names = FALSE)
  n <- length(col)
  name.pos <- match.arg(name.pos)
  if(!is.unit(height)) height <- unit(height, defualt.units)
  if(!is.unit(lspace)) lspace <- unit(lspace, defualt.units)
  if(!is.unit(rspace)) rspace <- unit(rspace, defualt.units)
  if(!is.unit(name.space)) name.space <- unit(name.space, defualt.units)
  grid.newpage()
  if(name){
    if(name.rot < 0 || name.rot > 180)
      stop("`name.rot` should be in c(0, 180).", call. = FALSE)
    namewidth <- max(stringWidth(col)) * name.cex * sin(name.rot / 180 * pi) + name.space
  }else {
    namewidth <- unit(0, "npc")
  }
  pushViewport(
    viewport(x = unit(0.5, "npc"),
                   y = unit(0.5, "npc"),
                   width = unit(1, "npc") - lspace - rspace,
                   height = height + namewidth,
                   name = "show-col")
  )
  if(name.pos == "top"){
    coly <- unit(0, "npc") + 1/2 * height
    namey <- unit(1, "npc") - 1/2 * namewidth
  }
  if(name.pos == "bottom"){
    coly <- unit(1, "npc") - 1/2 * height
    namey <- unit(0, "npc") + 1/2 * namewidth
  }

  grid.rect(x = unit((1:n - 0.5)/n, "npc"),
                  y = coly,
                  width = unit(1/n, "npc"),
                  height = height,
                  gp = gpar(
                    col = bcol,
                    fill = col))
  if(name){
    grid.text(label = col,
                    x = unit((1:n - 0.5)/n, "npc"),
                    y = namey,
                    rot = name.rot,
                    gp = gpar(
                      cex = name.cex
                    )
    )
  }
  upViewport()
}