o Added argument 'class' for injecting a 'class' attribute to the

  HTML canvas generated when RGL device is closed with devOffRGL().
o Added package vignette.

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: R.devices.rgl
-Version: 0.1.0
+Version: 0.1.1
 Depends: R (>= 3.1.2)
 Imports: R.methodsS3 (>= 1.6.1), R.oo (>= 1.18.0), R.utils (>= 1.34.0), R.devices (>= 2.12.0)
 Suggests: rgl (>= 0.95.1201), R.rsp (>= 0.19.0)
@@ -8,9 +8,9 @@ Authors@R: c(person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"),
                                           email = "henrikb@braju.com"))
 Author: Henrik Bengtsson [aut, cre, cph]
 Maintainer: Henrik Bengtsson <henrikb@braju.com>
-Date: 2015-01-28
+Date: 2015-02-03
 Title: Simple Functions for Creating WebGL Graphics
-Description: Simple functions for creating WebGL graphics using the rgl package.
+Description: Simple functions for creating WebGL graphics (using the rgl package) and include them in dynamically generated HTML documents.
 License: LGPL (>= 2.1)
 URL: https://github.com/HenrikBengtsson/R.devices.rgl
 BugReports: https://github.com/HenrikBengtsson/R.devices.rgl/issues

NAMESPACE

@@ -7,6 +7,8 @@ importFrom("R.utils", "setOption")
 importFrom("R.utils", "printf")
 importFrom("R.utils", "isFile")
 importFrom("R.methodsS3", "throw")
+importFrom("R.oo", "Package")
+importFrom("R.oo", "startupMessage")
 importFrom("R.oo", "trim")
 
 ## import("rgl")
@@ -24,6 +26,7 @@ import("R.devices")
 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 # EXPORTS
 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+export("R.devices.rgl")
 export("devEvalRGL")
 
 export("useRGL")

NEWS

@@ -2,6 +2,12 @@
 Package: R.devices.rgl
 ======================
 
+Version: 0.1.0-9000 [2015-02-03]
+o Added argument 'class' for injecting a 'class' attribute to the
+  HTML canvas generated when RGL device is closed with devOffRGL().
+o Added package vignette.
+
+
 Version: 0.1.0 [2015-01-28]
 o Created package.
 

R/999.package.R

@@ -0,0 +1,29 @@
+#########################################################################/**
+# @RdocPackage R.devices.rgl
+#
+# \description{
+#   @eval "getDescription(R.devices.rgl)"
+# }
+#
+# \section{To get started}{
+#   \itemize{
+#    \item Vignette '\href{../doc/index.html}{R.devices.rgl: Examples}'
+#    \item @see "toWebGL" - evaluate graphics code and atomically save HTML WebGL code to file.
+#   }
+# }
+#
+# \section{How to cite this package}{
+#   To cite this package, please use:
+# \preformatted{
+# @eval "paste(capture.output(toBibtex(citation(package='R.devices.rgl'))), collapse='\n')"
+# }
+# }
+#
+# \author{
+#  @eval "packageDescription('R.devices.rgl')$Author".
+# }
+#
+# \section{License}{
+#  @eval "packageDescription('R.devices.rgl')$License".
+# }
+#*/#########################################################################

R/webgl.R

@@ -33,6 +33,8 @@
 #     main HTML page.  By using @TRUE, each figure will include/define
 #     the same code, which slightly increases the output size, but
 #     is safe and valid to do.}
+#   \item{class}{A @character @vector specifying the CSS classes on
+#     the HTML canvas object that displays the WebGL graphics.}
 #   \item{...}{Additional arguments passed to @see "rgl::writeWebGL" upon
 #     closing the opened device.}
 # }
@@ -72,7 +74,7 @@
 # @keyword device
 # @keyword utilities
 #*/###########################################################################
-webgl <- function(filename="Rplot.WebGL.html", width=480L, height=480L, font=c("sans-serif", "Arial", "Helvetica"), useNULL=TRUE, snapshot=FALSE, header=TRUE, ...) {
+webgl <- function(filename="Rplot.WebGL.html", width=480L, height=480L, font=c("sans-serif", "Arial", "Helvetica"), useNULL=TRUE, snapshot=FALSE, header=TRUE, class=c("rglWebGL"), ...) {
   oopts <- useRGL(useNULL=useNULL)
   on.exit(options(oopts))
 
@@ -97,6 +99,11 @@ webgl <- function(filename="Rplot.WebGL.html", width=480L, height=480L, font=c("
   # Argument 'height':
   height <- Arguments$getNumeric(height, range=c(0,Inf))
 
+  # Argument 'class':
+  if (!is.null(class)) {
+    class <- Arguments$getCharacters(class)
+  }
+
   # Argument 'font':
   font <- unlist(strsplit(font, split=",", fixed=TRUE))
   font <- paste(trim(font), collapse=",")
@@ -115,7 +122,7 @@ webgl <- function(filename="Rplot.WebGL.html", width=480L, height=480L, font=c("
   # (a) Record device specific parameters needed when closing
   #     the device.
   args <- list(pathname=pathname, header=header, snapshot=snapshot,
-               width=width, height=height, font=font, ...)
+               width=width, height=height, font=font, class=class, ...)
   attr(args, "timestamp") <- Sys.time()
 ##  mstr(args)
 
@@ -134,6 +141,9 @@ webgl <- function(filename="Rplot.WebGL.html", width=480L, height=480L, font=c("
 
 ############################################################################
 # HISTORY:
+# 2015-02-03
+# o Added argument 'class' for injecting a 'class' attribute to the
+#   HTML canvas generated when RGL device is closed with devOffRGL().
 # 2015-01-28
 # o DOCUMENTATION: Added Rdoc help.
 # o Added useRGL().

R/writeWebGL.R

@@ -1,5 +1,5 @@
 # Writes current RGL device to a WebGL HTML file (atomically)
-.writeWebGL <- function(pathname, header=TRUE, ...) {
+.writeWebGL <- function(pathname, header=TRUE, class=c("rglWebGL"), ...) {
   # Argument 'pathname':
   pathname <- Arguments$getWritablePathname(pathname)
 
@@ -62,6 +62,18 @@
     bfr <- bfr[-idx]
   }
 
+  # Add 'class' attribute to HTML canvas?
+  if (length(class) > 0L) {
+    pattern <- sprintf('(<canvas)( *)(id=")', prefix);
+    pattern <- sprintf('(<canvas)( *)(id="%scanvas")', prefix);
+    idx <- grep(pattern, bfr)
+    if (length(idx) > 1L) {
+      throw(sprintf("Detected %d HTML canvases, but there should be exactly one.", length(idx)))
+    }
+    replace <- sprintf('\\1 class="%s" \\3', paste(class, collapse=" "))
+    bfr[idx] <- gsub(pattern, replace, bfr[idx])
+  }
+
   # (f) Cleanup
   # Remove auxillary files
   file.remove(c("CanvasMatrix.js", "WebGL.tmpl", "WebGL.html"))
@@ -80,6 +92,8 @@
 
 ############################################################################
 # HISTORY:
+# 2015-02-03
+# o Now .writeWebGL() can inject a 'class' attribute to the HTML canvas.
 # 2015-01-28
 # o DOCUMENTATION: Added Rdoc help.
 # o Added useRGL().

R/zzz.R

@@ -0,0 +1,18 @@
+## covr: skip=all
+
+.onLoad <- function(libname, pkgname) {
+  ns <- getNamespace(pkgname)
+  pkg <- Package(pkgname)
+  assign(pkgname, pkg, envir=ns)
+}
+
+.onAttach <- function(libname, pkgname) {
+  startupMessage(get(pkgname, envir=getNamespace(pkgname)))
+}
+
+
+############################################################################
+# HISTORY:
+# 2015-02-03
+# o Created.
+############################################################################

man/webgl.Rd

@@ -25,7 +25,7 @@
 
 \usage{
 webgl(filename="Rplot.WebGL.html", width=480L, height=480L, font=c("sans-serif", "Arial",
-  "Helvetica"), useNULL=TRUE, snapshot=FALSE, header=TRUE, ...)
+  "Helvetica"), useNULL=TRUE, snapshot=FALSE, header=TRUE, class=c("rglWebGL"), ...)
 }
 
 \arguments{
@@ -45,6 +45,8 @@ webgl(filename="Rplot.WebGL.html", width=480L, height=480L, font=c("sans-serif",
     main HTML page.  By using \code{\link[base:logical]{TRUE}}, each figure will include/define
     the same code, which slightly increases the output size, but
     is safe and valid to do.}
+  \item{class}{A \code{\link[base]{character}} \code{\link[base]{vector}} specifying the CSS classes on
+    the HTML canvas object that displays the WebGL graphics.}
   \item{...}{Additional arguments passed to \code{\link[rgl]{writeWebGL}} upon
     closing the opened device.}
 }

vignettes/examples.md.rsp

@@ -0,0 +1,88 @@
+<%@meta language="R-vignette" content="--------------------------------
+  DIRECTIVES FOR R:
+
+  %\VignetteIndexEntry{R.devices.rgl: Examples}
+  %\VignetteAuthor{Henrik Bengtsson}
+  %\VignetteKeyword{R}
+  %\VignetteKeyword{RSP}
+  %\VignetteKeyword{rgl}
+  %\VignetteKeyword{WebGL}
+  %\VignetteEngine{R.rsp::rsp}
+  %\VignetteTangle{FALSE}
+--------------------------------------------------------------------"%>
+<% t0 <- Sys.time() %>
+<% R.rsp <- R.oo::Package("R.rsp") %>
+<%
+options("withCapture/newline"=FALSE)
+options(width=110L)
+library("R.utils") ## withCapture()
+library("R.devices")
+library("R.devices.rgl")
+useRGL(useNULL=TRUE)
+%>
+
+<%--- HTML <style> should really be in the <head> not <body> ---%>
+<style type="text/css">
+.rglWebGL {
+  margin-left: auto;
+  margin-right: auto;
+  display: block; 
+  border: solid 1px #cccccc;
+}
+</style>
+
+
+# <%@meta name="title"%>
+
+<%@meta name="author"%> on <%=format(as.Date(R.rsp$date), format="%B %d, %Y")%>
+
+```r
+<%=withCapture({
+library('R.devices.rgl')
+})%>
+```
+
+## Examples
+
+### Example: 3D scatter plot
+```r
+<%=withCapture({
+x <- sort(rnorm(1000))
+y <- rnorm(1000)
+z <- rnorm(1000) + atan2(x, y)
+})%>
+```
+<%=toWebGL("plot3d", tags="example", {
+  plot3d(x, y, z, col=rainbow(1000))
+})%>
+
+
+### Example: 3D shapes
+This example is taken from the vignette of the [rgl] package.
+<%=toWebGL("shapes", tags="example", {
+layout3d(matrix(1:16, nrow=4, ncol=4), heights=c(1,3,1,3))
+cols <- rainbow(7)
+text3d(0,0,0,"tetrahedron3d"); next3d()
+shade3d(tetrahedron3d(col=cols[1])); next3d()
+text3d(0,0,0,"cube3d"); next3d()
+shade3d(cube3d(col=cols[2])); next3d()
+text3d(0,0,0,"octahedron3d"); next3d()
+shade3d(octahedron3d(col=cols[3])); next3d()
+text3d(0,0,0,"dodecahedron3d"); next3d()
+shade3d(dodecahedron3d(col=cols[4])); next3d()
+text3d(0,0,0,"icosahedron3d"); next3d()
+shade3d(icosahedron3d(col=cols[5])); next3d()
+text3d(0,0,0,"cuboctahedron3d"); next3d()
+shade3d(cuboctahedron3d(col=cols[6])); next3d()
+text3d(0,0,0,"oh3d"); next3d()
+shade3d(oh3d(col=cols[7]))
+})%>
+
+
+## Appendix
+To install R.devices.rgl, do:
+```r
+source('http://callr.org/install#HenrikBengtsson/R.devices.rgl')
+```
+
+[rgl]: http://cran.r-project.org/package=rgl