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

[Stephen Eglen]

 > 
 > For the archives (and for others if interested) I'll send my test
 > script tomorrow to the list.

Here it is.  

Stephen



## Simple example of playing a movie in tcltk.
## Tue 09 Jan 2007
## Use the 'after' command to repeatedly call the plot function after
## some delay.  (I tried an alternative method for running the movie,
## go.callback2, for those interested, but go.callback seems
## preferable.)

library(tcltk)

## Some dummy data.
npts <- 1000
step.size <- 40                         #how many data points to show.
data <- sin(4*pi * 1:npts/npts)

pause.time <- 100                       #delay in msec

movie.time <- tclVar(1)                 # current start time of frame.
movie.show <- tclVar(1)                 # "1" for on, "0" for off.


show.plot <- function(..., update.win=TRUE) {
  ## Update the plot window.
  ## TODO: check that beg/end times are suitable.
  start.time <- as.numeric(tclvalue(movie.time))
  
  x <- floor(start.time) + (1:step.size)
  plot(x, data[x], ylim=c(-1, 1), bty='n', lwd=3, col='red',
       main='dummy data', type='l', yaxt='n')

  if ( update.win && (tclvalue(movie.show)=="1")) {
    next.time <- start.time + step.size
    if (next.time < length(data)) {
      ## Still have more to show...
      tclvalue(movie.time) <- as.character(next.time)
      tcl("after", pause.time, show.plot)
    } else {
      tclvalue(movie.show) == "0"     #for consistency.
    }
  }
  
}

stop.callback <- function() {
  ## Callback for the stop button.
  tclvalue(movie.show) <- "0"
}

go.callback <- function() {
  ## Callback for the go button.
  tclvalue(movie.show) <- "1"
  show.plot()
}

go.callback2 <- function() {

  ## Alternative callback for the go button.  This uses a for loop to
  ## control the movie; however, while the movie is running, the R
  ## prompt is blocked (although the tk GUI is still responsive).
  
  print("Alternate go callback")
  tclvalue(movie.show) <- "1"

  looping <- TRUE

  while(looping) {
    show.plot(update.win=FALSE)
    cur.time <- as.numeric(tclvalue(movie.time))
    if ( (tclvalue(movie.show) == "0") || cur.time >= length(data)) {
      looping <- FALSE
      tclvalue(movie.show) <- "0"       #needed iff at end of data.
    } else {
      Sys.sleep(pause.time/1000)        #1000 needed to give time in sec.
      tclvalue(movie.time) <-
        as.character( cur.time + step.size)
    }
  }
}

show.plot.scale <- function(...) {
  ## Callback for the scale widget.
  show.plot(update.win=FALSE)
}

movie.window <- function() {
  ## Create a control window and show it.
  
  ## Init the vars?
  tclvalue(movie.time) <- "1"
  
  
  ## Create base frame.
  base <- tktoplevel()
  spec.frame <- tkframe(base, borderwidth=2)
  tkwm.title(base, "Movie player")
  
  beg.time <- 1
  end.time <- length(data)
  scale <- tkscale(spec.frame, command=show.plot.scale,
                   from = beg.time,
                   to =   end.time, 
                   showvalue=TRUE,
                   variable=movie.time,
                   resolution=5,
                   orient="horiz")
  
  go.but   <- tkbutton(spec.frame, text="Go",   command=go.callback2)
  prev.but <- tkbutton(spec.frame, text="Stop", command=stop.callback)
  

  ## Add buttons, one row at a time, using the grid manager.
  tkgrid(scale, columnspan=2)
  tkgrid(go.but, prev.but)
  
  tkpack(spec.frame)

}



movie.window()