[R-gui] Idle/timer callbacks in tk widgets

[Duncan Murdoch]

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