R/v8_chroma_context.R

In jiho/chroma: Parse and Manipulate Colors, Create Perceptually Correct Color Palettes

# Create a chroma-aware javascript interpreting context
#
# Use the \code{\link[V8]{v8}} function of package \code{V8} to create the context and evaluate the code of chroma.js, thus making all functions available.
#
# @seealso \code{\link[V8]{v8}} and \url{http://gka.github.io/chroma.js/}
#
# @examples
# ct <- v8_chroma_context()
# ct$eval("chroma('pink').darken().saturate(2).hex()")
#
# @export
#' @importFrom V8 v8
v8_chroma_context <- function() {
  # get chroma.js's location
  file <- system.file("chroma.min.js", package="chroma")

  # read the file and make it into a single character scalar
  chromajs <- scan(file, what="character", skip=57, sep="\n", quiet=T)
  chromajs <- paste(chromajs, collapse="")

  # create the context
  ct <- v8()

  # "load" chroma
  ct$eval(chromajs)

  # return the context
  return(ct)
}

# Create a vsup-aware javascript interpreting context
#
# Use the \code{\link[V8]{v8}} function of package \code{V8} to create the context and evaluate the code of vsup.js, thus making all functions available.
#
# @seealso \code{\link[V8]{v8}} and \url{https://github.com/uwdata/vsup}
#
# @examples
# ct <- v8_vsup_context()
# css(ct$eval("vsup.scale()(0.8, 0.1)"))
#
# @export
#' @importFrom V8 v8
v8_vsup_context <- function() {
  # as above, for chroma.js
  file <- system.file("vsup.min.js", package="chroma")

  vsupjs <- scan(file, what="character", sep="\n", quiet=T)

  ct <- v8()
  ct$eval(vsupjs)

  return(ct)
}

# Create a chroma and vsup-aware javascript interpreting context
#
# Use the \code{\link[V8]{v8}} function of package \code{V8} to create the context and evaluate the code of chroma.js and vsup.js, thus making all functions available.
#
# @seealso \code{\link[V8]{v8}}, \url{http://gka.github.io/chroma.js/}, and \url{https://github.com/uwdata/vsup}
#
# @examples
# ct <- v8_all_context()
# show_col(css(ct$eval("vsup.scale().range(chroma.scale(['yellow', 'red']))(0.8, 0.5)")))
#
# @export
#' @importFrom V8 v8
v8_all_context <- function() {
  # get chroma.js's location
  file <- system.file("chroma.min.js", package="chroma")

  # read the file and make it into a single character scalar
  chromajs <- scan(file, what="character", skip=57, sep="\n", quiet=T)
  chromajs <- paste(chromajs, collapse="")
  file <- system.file("vsup.min.js", package="chroma")
  vsupjs <- scan(file, what="character", sep="\n", quiet=T)

  # create the context
  ct <- v8()

  # "load" chroma
  ct$eval(chromajs)
  ct$eval(vsupjs)

  # return the context
  return(ct)
}

# Evaluate commands in a V8 context
#
# Evaluate javascript commands in a V8 context. By default, this context is chroma-aware.
#
# @param command vector of strings to evaluate.
# @param context context to evaluate in.
#
# @examples
# v8_eval(c("chroma('pink').darken().hex()", "chroma.scale(['red','blue']).colors(5)", "chroma.mix('blue', 'red').hex()"))
#' @importFrom stats na.omit
v8_eval <- function(command, context=v8_chroma_context()) {
  # run valid (i.e. non NA) v8 commands
  # (and ensure the result is a vector)
  out <- unlist(lapply(na.omit(command), context$eval))
  # make upper case for consistency with other color-related functions in R
  out <- toupper(out)
  # re-insert NAs
  out <- na_insert(out, from=command)
  return(out)
}