>
> 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()
_______________________________________________
R-SIG-GUI mailing list
R-SIG-GUI@stat.math.ethz.ch
https://stat.ethz.ch/mailman/listinfo/r-sig-gui
