[R] Defining origin for rotation in RGL device

[Duncan Murdoch]

On 25/04/2011 7:54 AM, Duncan Murdoch wrote:
> 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)
}