Re: [R] Defining origin for rotation in RGL device

From: Duncan Murdoch <murdoch.duncan_at_gmail.com>
Date: Mon, 25 Apr 2011 12:51:38 -0400

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)

}

R-help_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide http://www.R-project.org/posting-guide.html and provide commented, minimal, self-contained, reproducible code. Received on Mon 25 Apr 2011 - 16:57:15 GMT

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Mon 25 Apr 2011 - 17:20:33 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.

list of date sections of archive