Defining origin for rotation in RGL device

Hi all,

How can I tell RGL to set the center for the rotation to the origin of  the coordinate system (0,0,0).
It seems that the default is to use the center of the display not the origin of the coordinate system.

open3d()
lines3d(c(0, 1), c(0,0), c(0,0))
lines3d(c(0,0), c(0, 1), c(0,0))
lines3d(c(0,0), c(0,0), c(0, 1))

You can attach any transformation you like to a mouse button.  See the 
"mouseCallbacks" demo for R implementations of the standard ones, and 
modify the mouseTrackball function there to choose the position of the 
origin of the coordinate system as the centre of rotation.

Duncan Murdoch

On 25/04/2011 5:46 AM, Mark Heckmann wrote:

 Hi all,

 How can I tell RGL to set the center for the rotation to the origin of  the coordinate system (0,0,0).
 It seems that the default is to use the center of the display not the origin of the coordinate system.

 open3d()
 lines3d(c(0, 1), c(0,0), c(0,0))
 lines3d(c(0,0), c(0, 1), c(0,0))
 lines3d(c(0,0), c(0,0), c(0, 1))

You can attach any transformation you like to a mouse button.  See the
"mouseCallbacks" demo for R implementations of the standard ones, and
modify the mouseTrackball function there to choose the position of the
origin of the coordinate system as the centre of rotation.

This was a little trickier than I was thinking because of the weird 
coordinate system.  You have to remember to transpose translationMatrix 
when you're planning to work in the coordinates of userMatrix.   Here's 
a function (modified from mouseTrackball in the demo) that I think does 
what you want.

Just call

mouseTrackballOrigin()

to set it up on button 1 on the current device with center of rotation 
at (0,0,0).

Duncan Murdoch

mouseTrackballOrigin <- function(button = 1, dev = rgl.cur(), 
origin=c(0,0,0) ) {
     width <- height <- rotBase <- NULL
     userMatrix <- list()
     cur <- rgl.cur()
     offset <- NULL
     scale <- NULL

     screenToVector <- function(x, y) {
       radius <- max(width, height)/2
       centre <- c(width, height)/2
       pt <- (c(x, y) - centre)/radius
       len <- vlen(pt)

       if (len > 1.e-6) pt <- pt/len

       maxlen <- sqrt(2)
       angle <- (maxlen - len)/maxlen*pi/2
       z <- sin(angle)
       len <- sqrt(1 - z^2)
       pt <- pt * len
       return (c(pt, z))
     }

     trackballBegin <- function(x, y) {
         vp <- par3d("viewport")
         width <<- vp[3]
         height <<- vp[4]
         cur <<- rgl.cur()
         bbox <- par3d("bbox")
         center <- c(sum(bbox[1:2])/2, sum(bbox[3:4])/2, sum(bbox[5:6])/2)
         scale <<- par3d("scale")
         offset <<- (center - origin)*scale
         for (i in dev) {
             if (inherits(try(rgl.set(i, TRUE)), "try-error")) dev <<- 
dev[dev != i]
             else userMatrix[[i]] <<- par3d("userMatrix")
         }
         rgl.set(cur, TRUE)
         rotBase <<- screenToVector(x, height - y)
     }

     trackballUpdate <- function(x,y) {
         rotCurrent <- screenToVector(x, height - y)
         angle <- angle(rotBase, rotCurrent)
         axis <- xprod(rotBase, rotCurrent)
         mouseMatrix <- rotationMatrix(angle, axis[1], axis[2], axis[3])
         for (i in dev) {
             if (inherits(try(rgl.set(i, TRUE)), "try-error")) dev <<- 
dev[dev != i]
             else par3d(userMatrix = t(translationMatrix(-offset[1], 
-offset[2], -offset[3])) %*% mouseMatrix  %*% 
t(translationMatrix(offset[1], offset[2], offset[3])) %*%userMatrix[[i]])
         }
         rgl.set(cur, TRUE)
     }

     for (i in dev) {
         rgl.set(i, TRUE)
         rgl.setMouseCallbacks(button, begin = trackballBegin, update = 
trackballUpdate, end = NULL)
     }
     rgl.set(cur, TRUE)
}