encode.R

#' Encode colours into RGB hex-strings
#' 
#' This is a version of [grDevices::rgb()] that works with the standard colour
#' format used in farver (matrix or data.frame with colours in rows). It further
#' support taking input from any colour space.
#' 
#' @inheritSection convert_colour Handling of non-finite and out of bounds values
#' 
#' @param colour A numeric matrix (or an object coercible to one) with colours 
#' encoded in the rows and the different colour space values in the columns. For 
#' all colourspaces except `'cmyk'` this will mean a matrix with three columns - 
#' for `'cmyk'` it means four columns. Alternatively, `colour` may be a list of
#' length three (or four for `'cmyk'`) numeric vectors of the same length.
#' @param alpha A numeric vector between 0 and 1. Will be recycled to the number
#' of rows in `colour`. If `NULL` or a single `NA` it will be ignored.
#' @param from The input colour space. Allowed values are: `"cmy"`, 
#' `"cmyk"`, `"hsl"`, `"hsb"`, `"hsv"`, `"lab"` (CIE L*ab), `"hunterlab"` 
#' (Hunter Lab), `"oklab"`, `"lch"` (CIE Lch(ab) / polarLAB), `"luv"`, 
#' `"rgb"` (sRGB), `"xyz"`, `"yxy"` (CIE xyY), `"hcl"` (CIE Lch(uv) / polarLuv),
#' or `"oklch"` (Polar form of oklab)
#' @param white The white reference of the input colour space. Will only have an 
#' effect for relative colour spaces such as Lab and luv. Any value accepted by 
#' [as_white_ref()] allowed.
#' 
#' @return A character vector with colours encoded as `#RRGGBB(AA)`
#' 
#' @family encoding and decoding functions
#' 
#' @note The output may differ slightly from that of [grDevices::rgb()] since
#' `rgb()` doesn't round numeric values correctly.
#' 
#' @export
#' 
#' @examples 
#' spectrum <- decode_colour(rainbow(10))
#' 
#' encode_colour(spectrum)
#' 
#' # Attach alpha values
#' encode_colour(spectrum, alpha = c(0.5, 1))
#' 
#' # Encode from a different colour space
#' spectrum_hcl <- convert_colour(spectrum, 'rgb', 'hcl')
#' encode_colour(spectrum_hcl, from = 'hcl')
#' 
encode_colour <- function(colour, alpha = NULL, from = 'rgb', white = 'D65') {
  if (from != 'rgb') {
    white <- as_white_ref(white)
  }
  encode_c(colour, alpha, colourspace_match(from), white, out_format = 1L)
}

encode_c <- function(colour, alpha, from, white, out_format = 1L) {
  # colour has zero colours:
  if ((is.matrix(colour) || is.data.frame(colour)) && nrow(colour) == 0) {
    return(character())
  }
  # Colour has zero colours (given as a list of channels)
  if (is.list(colour) && (length(colour) == 0 || length(colour[[1]]) == 0)) {
    return(character())
  }
  # Colour is neither a list or a matrix, so let's coerce it
  if (!is.matrix(colour) && !is.list(colour)) {
    colour <- as.matrix(colour)
  }
  # How many colours do we have?
  if (is.matrix(colour)) {
    num_colours <- nrow(colour)
  } else {
    num_colours <- length(colour[[1]])
  }

  if (!is.null(alpha)) {
    alpha <- alpha * 255
    if (length(alpha) == 0) {
      alpha <- NULL
    } else if (length(alpha) != 1) {
      alpha <- rep_len(alpha, num_colours)
    } else if (is.na(alpha) || alpha == 1) {
      alpha <- NULL
    }
  }
  out_format <- as.integer(out_format)
  if (out_format != 1L && out_format != 2L) {
    stop("out_format must be 1L (for character) or 2L (for native)")
  }
  .Call(`farver_encode_c`, colour, alpha, as.integer(from), white, out_format)
}