Keep IDs consistent so test results don't change.

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: rgl
-Version: 1.3.12
+Version: 1.3.13
 Title: 3D Visualization Using OpenGL
 Authors@R: c(person("Duncan", "Murdoch", role = c("aut", "cre"),
                      email = "[email protected]"),

NAMESPACE

@@ -38,7 +38,8 @@ export(.check3d,
   rgl.primitive, rgl.projection, rgl.quads, rgl.quit, rgl.Sweave, rgl.Sweave.off,
   rgl.select, rgl.select3d, rgl.set, rgl.snapshot, rgl.spheres, rgl.sprites,
   rgl.surface, rgl.texts, rgl.triangles, rgl.user2window,
-  rgl.attrib, rgl.attrib.count, rgl.attrib.info, rgl.dev.list, rgl.useNULL,
+  rgl.attrib, rgl.attrib.count, rgl.attrib.info, 
+  rgl.dev.list, rgl.incrementID, rgl.useNULL,
   rgl.viewpoint, rgl.window2user, rglExtrafonts,
   rglFonts, rglId, rglMouse, rglShared, rglToLattice, rglToBase,
   r3dDefaults, rotate3d, rotationMatrix,

NEWS.md

@@ -1,3 +1,18 @@
+# rgl 1.3.13
+
+## Minor changes
+
+* `rgl.incrementID()` has been added.
+
+## Bug fixes
+
+* `clear3d("all")`, calling `bg3d()` on the root 
+subscene, and some cases of `pop3d()` involving the 
+background could create a leak of a background object
+(issue #439).  For back compatibility, these cases
+still increment the object ID number, but don't
+actually create a new object.
+
 # rgl 1.3.12
 
 ## Minor changes

R/r3d.rgl.R

@@ -41,11 +41,14 @@ clear3d     <- function(type = c("shapes", "bboxdeco", "material"),
   type <- names(typeid)
 
   if (subscene == 0) {
-    idata <- as.integer(c(length(typeid), typeid))    	
+    nobg <- setdiff(typeid, 6)
+    idata <- as.integer(c(length(nobg), nobg))    	
     ret <- .C( rgl_clear, 
                success = FALSE,
                idata
     )$success
+    if (6 %in% typeid)
+      rgl.incrementID()  # for back compatibility
 
     if (! ret)
       stop("'rgl_clear' failed")
@@ -226,6 +229,8 @@ bg3d        <- function(color,
       else if (flags["exp_fog", 1]) "exp"
       else if (flags["exp2_fog", 1]) "exp2"
       else "none"
+    if (currentSubscene3d() == rootSubscene())
+      rgl.incrementID()  # for back compatibility
   }
   dots <- list(...)
 
@@ -1116,3 +1121,7 @@ snapshot3d <- function(filename = tempfile(fileext = ".png"),
   }
   rgl.snapshot(filename, fmt, top)
 }
+
+rgl.incrementID <- function(n = 1L) {
+  .C(rgl_incrementID, n = as.integer(n))$n
+}

R/scene.R

@@ -31,11 +31,14 @@ rgl.clear <- function( type = "shapes", subscene = 0 )  {
   type <- names(typeid)
 
   if (subscene == 0) {
-    idata <- as.integer(c(length(typeid), typeid))    	
+    nobg <- setdiff(typeid, 6)
+    idata <- as.integer(c(length(nobg), nobg))
     ret <- .C( rgl_clear, 
       success = FALSE,
       idata
     )$success
+    if (6 %in% typeid)
+      rgl.incrementID()  # For back compatibility
   } else {
     sceneids <- ids3d(type=type, subscene = 0)$id
     thisids <- ids3d(type=type, subscene = subscene)$id

man/rgl.incrementID.Rd

@@ -0,0 +1,28 @@
+\name{rgl.incrementID}
+\alias{rgl.incrementID}
+\title{
+Increment ID
+}
+\description{
+This function is mainly for internal use.  It simply 
+increments the internal object ID number and returns
+the new value.  Negative values have no effect.
+}
+\usage{
+rgl.incrementID(n = 1L)
+}
+\arguments{
+  \item{n}{
+An integer increment to use.
+}
+}
+\value{
+The resulting ID value.
+}
+\examples{
+# Get the current ID value
+rgl.incrementID(0)
+
+# Increment it
+rgl.incrementID()
+}

src/api.cpp

@@ -1374,3 +1374,10 @@ void rgl::rgl_postscript(int* successptr, int* idata, char** cdata)
 
   *successptr = success;
 }
+
+void rgl::rgl_incrementID(int* n)
+{
+  if (*n > 0)
+    SceneNode::nextID += *n;
+  *n = SceneNode::nextID;
+}

src/api.h

@@ -115,6 +115,8 @@ SEXP rgl_par3d(SEXP device, SEXP subscene, SEXP args);
 /* These may be removed if observer is set completely by par3d */
 void rgl_getObserver(int* successptr, double* ddata);
 void rgl_setObserver(int* successptr, double* ddata);
+void rgl_incrementID(int* n);
+
 #ifdef __cplusplus
 }
 #endif

src/init.cpp

@@ -189,6 +189,7 @@ SEXP rgl_init(SEXP initValue, SEXP useNULL, SEXP in_namespace,
    {"rgl_selectstate", 		(DL_FUNC) &rgl_selectstate, 5, aIILID},
    {"rgl_setselectstate",	(DL_FUNC) &rgl_setselectstate, 4, aIILI},
    {"rgl_quit",			(DL_FUNC) &rgl_quit, 1, aL},
+   {"rgl_incrementID", (DL_FUNC) &rgl_incrementID, 1, aI},
 
    {NULL, NULL, 0}
  };
@@ -240,6 +241,7 @@ SEXP rgl_init(SEXP initValue, SEXP useNULL, SEXP in_namespace,
    FUNDEF(rgl_selectstate, 5),
    FUNDEF(rgl_setselectstate, 4),
    FUNDEF(rgl_quit, 1),
+   FUNDEF(rgl_incrementID, 1),
 
    {NULL, NULL, 0}
  };