From: Duncan Murdoch <murdoch.duncan_at_gmail.com>

Date: Mon, 25 Apr 2011 12:51:38 -0400

}

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

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.
*