diff --git a/DESCRIPTION b/DESCRIPTION index 8a93870..45e2bdc 100644 --- a/DESCRIPTION +++ b/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 -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 diff --git a/NAMESPACE b/NAMESPACE index 406d5a9..572637f 100644 --- a/NAMESPACE +++ b/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") diff --git a/NEWS b/NEWS index ee5145b..8cbd838 100644 --- a/NEWS +++ b/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. diff --git a/R/999.package.R b/R/999.package.R new file mode 100644 index 0000000..c9d4b67 --- /dev/null +++ b/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". +# } +#*/######################################################################### diff --git a/R/webgl.R b/R/webgl.R index d5b6706..355914a 100644 --- a/R/webgl.R +++ b/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(). diff --git a/R/writeWebGL.R b/R/writeWebGL.R index 61074c6..515d4ef 100644 --- a/R/writeWebGL.R +++ b/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('( 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(). diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..8c31bf1 --- /dev/null +++ b/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. +############################################################################ diff --git a/man/webgl.Rd b/man/webgl.Rd index da1455b..6958c89 100644 --- a/man/webgl.Rd +++ b/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.} } diff --git a/vignettes/examples.md.rsp b/vignettes/examples.md.rsp new file mode 100644 index 0000000..2985da1 --- /dev/null +++ b/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 + + +# <%@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