On 1/9/2007 8:08 AM, Stephen Eglen wrote:
> >
> > For the archives (and for others if interested) I'll send my test
> > script tomorrow to the list.
>
> Here it is.
I did a similar thing in the tkrgl package (recently uploaded to CRAN),
to control rotating rgl plots.
A few differences:
I queried the system clock to set the amount of rotation, so it would
appear to rotate at a continuous rate even if the update wasn't serviced
regularly.
I used tcl("after", "idle", onIdle) to trigger the next update. This is
supposed to avoid callbacks when the system is busy, but it still makes
a bit too much impact on the system. Probably the best low impact way
would be to follow a fixed delay with an "idle" delay, to guarantee a
minimum delay time.
I defined all the event handling functions within one wrapper function,
so they had access to its variables through lexical scoping, without
exposing them all to the whole world.
Here's some of the code (just for the "up" rotation, there's a lot of
repetitiveness for other kinds of rotation. The repetition could be
reduced by just setting the rotation axis and direction, but it doesn't
really seem worth the effort). Improvements would be welcome.
Duncan Murdoch
spinControl <- function(base, dev = rgl.cur()){
# This creates a control that can be put in the tk container called base
slider <- tclVar(100) # this controls the rotation rate
continuous <- tclVar(0) # this controls whether rotation continues on
its own
buttonPress <- NULL
direction <- NULL
lastTime <- proc.time()[3] # this records the last time the display
was updated
timeDiff <- 0
# Here's a typical rotation function:
rotateUp <- function(){
angle <- timeDiff*as.numeric(tclObj(slider))*pi/180
par3d(userMatrix = rotationMatrix(-angle, 1,0,0) %*%
par3d("userMatrix"))
}
rotate <- function(){
old <- rgl.cur()
on.exit(rgl.set(old))
if (buttonPress) {
if ((currentTime <- proc.time()[3]) > lastTime) {
timeDiff <<- currentTime - lastTime
lastTime <<- currentTime
for (device in dev) {
rgl.set(device)
if (direction == "up")
rotateUp()
...
}
}
tcl("after",5,rotate) # rotation is continuous as long as
the
button is pressed.
}
}
# rotation button callback functions
# note that "..." argument is necessary
upButtonPress <- function(...){
buttonPress <<- TRUE
lastTime <<- proc.time()[3]
direction <<- "up"
rotate()
}
...
onIdle <- function(...){
buttonPress <<- TRUE
rotate()
buttonPress <<- FALSE
if (as.numeric(tclObj(continuous)))
tcl("after", "idle", onIdle)
}
The idle rotation only happens if the continuous variable is non-zero
when a button is released. It's connected to a checkbox.
buttonRelease <- function(...){
buttonPress <<- FALSE
if (as.numeric(tclObj(continuous)))
tcl("after", "idle", onIdle)
}
....
}
Duncan Murdoch
_______________________________________________
R-SIG-GUI mailing list
R-SIG-GUI@stat.math.ethz.ch
https://stat.ethz.ch/mailman/listinfo/r-sig-gui
