#' Render a WebGL Element
#'
#' Render a WebGL Shiny output.
#' @param expr The expression to be evaluated which should produce a rgl scene.
#' @param width Either "auto", in which case the width will be calculated
#' (reactively) based on the size of the glOutput element associated with this
#' function, or a numeric value representing the width of the desired WebGL
#' scene in pixels.
#' @param height The height of the WebGL scene. See \code{width} for details.
#' @param env The environment in which \code{expr} should be evaluated.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#' is useful if you want to save an expression in a variable.
#' @importFrom rgl open3d
#' @importFrom rgl bg3d
#' @importFrom rgl rgl.close
#' @importFrom rgl writeWebGL
#' @importFrom rgl par3d
#' @importFrom shiny exprToFunction
#' @importFrom shiny HTML
#' @importFrom shiny isolate
#' @author Jeff Allen \email{jeff@@trestletech.com}
#' @examples \dontrun{
#' renderWebGL({
#' points3d(1:10,1:10,1:10)
#' })
#' }
#' @export
renderWebGL <- function(expr, width="auto", height="auto", env = parent.frame(),
quoted = FALSE){
func <- exprToFunction(expr, env, quoted)
return(function(shinysession, name, ...) {
#Open a null RGL device.
open3d(useNULL = TRUE)
func()
prefix <- "gl_output_"
# Read in WebGL's width and height from the browser
if (width == "auto") width <- shinysession$clientData[[paste(prefix,
name, "_width", sep = "")]]
if (height == "auto") height <- shinysession$clientData[[paste(prefix,
name, "_height", sep = "")]]
if (is.null(width) || is.null(height) || width <= 0 ||
height <= 0) return(NULL)
if (is.null(width) || !is.numeric(width)){
stop("Can't support non-numeric width parameter. 'width' must be in px.")
}
if (is.null(height) || !is.numeric(height)){
stop("Can't support non-numeric height parameter. 'height' must be in px.")
}
# Read in current values as they're updated so that we can regenerate
# the graph honoring the user's changes to the view, but isolate() so we
# don't force a new graph every time the user interacts with it.
zoom <-
isolate(shinysession$clientData[[paste(prefix, name, "_zoom", sep="")]])
fov <-
isolate(shinysession$clientData[[paste(prefix, name, "_fov", sep="")]])
pan <-
isolate(shinysession$clientData[[paste(prefix, name, "_pan", sep="")]])
if (!is.null(zoom)){
par3d(zoom = zoom)
}
if (!is.null(fov)){
par3d(FOV=fov)
}
if (!is.null(pan)){
mat <- matrix(pan, ncol=4)
par3d(userMatrix=mat)
}
#generate a random 10 character sequence to represent this file
id <- paste(sample(c(letters, LETTERS), 10), collapse="")
tempDir <- paste(tempdir(), "/", id, "/", sep="")
# Write out a template file containing the prefix.
# TODO: Work with RGL guys to clean this up.
tempFile <- file(file.path(tempdir(), paste(id,".html", sep="")), "w");
writeLines(paste("%", id, "WebGL%", sep=""),
tempFile)
close(tempFile)
# Write out the WebGL file and read it back in
# TODO: Work with RGL guys to clean this process up.
writeWebGL(dir=tempDir, snapshot= FALSE,
template=file.path(tempdir(),paste(id,'.html', sep="")),
height=height, width=width, prefix=id)
#read in the file
lines <- readLines(paste(tempDir, "/index.html", sep=""))
#remove canvasMatrix load -- we'll load it elsewhere
lines <- lines[-1]
#remove the temporary directory
#TODO: Doesn't seem to work in Windows
unlink(tempDir, recursive=TRUE)
#remove the template file.
unlink(paste(tempdir(), id,".html", sep=""))
rgl.close()
#return the HTML lines generated by RGL
toRet <- paste(lines, collapse="\n")
return(list(prefix=id,html=HTML(toRet)))
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.