pan3d <- function(button, dev = cur3d(), subscene = currentSubscene3d(dev)) {
   start <- list()
   
   begin <- function(x, y) {
     activeSubscene <- par3d("activeSubscene", dev = dev)
     start$listeners <<- par3d("listeners", dev = dev, subscene = activeSubscene)
     for (sub in start$listeners) {
       init <- par3d(c("userProjection","viewport"), dev = dev, subscene = sub)
       init$pos <- c(x/init$viewport[3], 1 - y/init$viewport[4], 0.5)
       start[[as.character(sub)]] <<- init
     }
   }
   
   update <- function(x, y) {
     for (sub in start$listeners) {
       init <- start[[as.character(sub)]]
       xlat <- 2*(c(x/init$viewport[3], 1 - y/init$viewport[4], 0.5) - init$pos)
       mouseMatrix <- translationMatrix(xlat[1], xlat[2], xlat[3])
       par3d(userProjection = mouseMatrix %*% init$userProjection, dev = dev, subscene = sub )
      }
   }
   rgl.setMouseCallbacks(button, begin, update, dev = dev, subscene = subscene)
   cat("Callbacks set on button", button, "of RGL device", dev, "in subscene", subscene, "\n")
 }
 open3d()
 shade3d(icosahedron3d(), col = "yellow")
 # This only works in the internal display...
 pan3d(1)
Run the code above in your browser using DataLab