Merge pull request #394 from dmurdoch/devoff

Add safe.dev.off() function

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: rgl
-Version: 1.2.6
+Version: 1.2.7
 Title: 3D Visualization Using OpenGL
 Authors@R: c(person("Duncan", "Murdoch", role = c("aut", "cre"),
  email = "murdoch.duncan@gmail.com"),

NAMESPACE

@@ -45,6 +45,7 @@ export(.check3d,
  scale3d, scaleMatrix, scene3d, segments3d, 
  select3d, selectionFunction3d, selectpoints3d,
  rgl.setAxisCallback, rgl.setMouseCallbacks, rgl.setWheelCallback,
+ safe.dev.off,
  set3d, setAxisCallbacks, setGraphicsDelay, setupKnitr, 
  setUserCallbacks, setUserShaders, shade3d, shadow3d,
 
@@ -168,7 +169,7 @@ export(.check3d,
  importFrom(graphics, legend, par, plot, plot.new, polygon,
  strwidth, strheight)
  importFrom(grDevices, as.raster, col2rgb, colorRamp, dev.cur, dev.new, 
- dev.off, png, postscript, rgb, xy.coords, xyz.coords)
+ dev.off, dev.prev, dev.set, png, postscript, rgb, xy.coords, xyz.coords)
  importFrom(stats, approxfun, get_all_vars, model.frame, 
  qchisq, qf, splinefun, terms, var)
  importFrom(tools, file_ext)

NEWS.md

@@ -1,4 +1,4 @@
-# rgl 1.2.6
+# rgl 1.2.7
 
 ## Minor changes
 
@@ -12,6 +12,8 @@ run in a Shiny session.
 `plotmath3d()` (pull request #384).
 * `polygon3d()` failed when given exactly 3 points (issue #388).
 * `snapshot3d()` failed on Windows with some versions of `webshot2` (issue #391).
+* Fixed issues caused by misuse of `dev.off()` using new function
+`safe.dev.off()`.
 
 # rgl 1.2.1
 

R/bgplot3d.R

@@ -1,3 +1,12 @@
+safe.dev.off <- function(which = dev.cur(), prev = dev.prev()) {
+ force(prev)
+ grDevices::dev.off(which)
+ if (length(dev.list()))
+ dev.set(prev)
+}
+
+dev.off <- function(...) stop("Use safe.dev.off() instead!")
+
 legend3d <- function(...) {
  args <- list(...)
  bgargs <- setdiff(names(formals(bgplot3d)),
@@ -26,7 +35,7 @@ bgplot3d <- function(expression, bg.color = getr3dDefaults("bg", "color"),
  bg = bg.color)
  grDevices::devAskNewPage(FALSE)
  value <- try(expression) 
- dev.off()
+ safe.dev.off()
  result <- bg3d(texture = filename, col = "white", lit = FALSE, ...)
  } else {
  value <- NULL
@@ -61,7 +70,7 @@ show2d <- function(expression,
  filename <- tempfile(fileext = ".png")
  png(filename = filename, width=width, height=height)
  value <- try(expression) 
- dev.off()
+ safe.dev.off()
  } else
  value <- filename
  face <- c(strsplit(face, '')[[1]], '-')[1:2]

R/plotmath3d.R

@@ -33,7 +33,7 @@ plotmath3d <- function(x, y = NULL, z = NULL,
  w <- strwidth(thistext, cex = initCex, ...)
  w1 <- strwidth("m", cex = initCex, ...)
  h <- strheight(thistext, cex = initCex, ...)
- dev.off()
+ safe.dev.off()
 
  # Now make a smaller bitmap
  expand <- 1.5
@@ -44,7 +44,7 @@ plotmath3d <- function(x, y = NULL, z = NULL,
  usr = c(0, 1, 0, 1))
  plot.new()
  text(0.5, 0.5, thistext, adj = c(0.5,0.5), cex = initCex, ...)
- dev.off()
+ safe.dev.off()
  # The 0.4 tries to match the text3d offset
  offseti <- 0.4*offset*h/w
  posi <- if (is.null(pos)) NULL else pos[i]

R/zzz.R

@@ -115,7 +115,7 @@
  !(.Platform$GUI %in% c("AQUA", "RStudio"))) &&
  exists("quartz", getNamespace("grDevices"))) {
  grDevices::quartz()
- dev.off()
+ safe.dev.off()
  }
 
  ret <- rgl.init(initValue, onlyNULL)

_pkgdown.yml

@@ -248,6 +248,7 @@ reference:
  - checkDeldir
  - Buffer
  - gltfTypes
+ - safe.dev.off
 - title: General documentation
 - contents:
  - rgl-package

man/safe.dev.off.Rd

@@ -0,0 +1,54 @@
+\name{safe.dev.off}
+\alias{safe.dev.off}
+\title{
+Close graphics device in a safe way.
+}
+\description{
+The \code{\link{dev.off}} function in \pkg{grDevices} doesn't restore
+the previous graphics device when called. This function does.
+}
+\usage{
+safe.dev.off(which = dev.cur(), prev = dev.prev())
+}
+\arguments{
+ \item{which}{
+Which device to close.
+}
+ \item{prev}{
+Which device to set as current after closing.
+}
+}
+\value{
+The number and name of the new active device.
+}
+\references{
+\url{https://bugs.r-project.org/show_bug.cgi?id=18604}
+}
+\author{
+Duncan Murdoch
+}
+\examples{
+# Open a graphics device
+dev.new()
+first <- dev.cur()
+
+# Open a second graphics device
+dev.new()
+second <- dev.cur()
+second
+
+# Open another one, and close it using dev.off()
+dev.new()
+dev.off()
+dev.cur() == second # Not the same as second!
+
+# Try again with safe.dev.off()
+dev.set(second)
+dev.new()
+safe.dev.off()
+dev.cur() == second
+
+# Close the other two devs
+safe.dev.off()
+safe.dev.off()
+}

vignettes/rgl.Rmd

@@ -374,7 +374,7 @@ because the texture coordinates run from 0 to 2 in both
 filename <- tempfile(fileext = ".png")
 png(filename = filename)
 plot(rnorm(1000), rnorm(1000))
-dev.off()
+safe.dev.off()
 open3d()
 xyz <- cbind(c(0,1,1,0), 0, c(0,0,1,1))
 quads3d(xyz, texture = filename, texcoords = xyz[,c(1, 3)]*2,